Browse Source

Added Data.SCargot.Basic to demonstrate usage of naive sexpr encoding

Getty Ritter 9 years ago
parent
commit
67255533ca
2 changed files with 55 additions and 2 deletions
  1. 49 0
      Data/SCargot/Basic.hs
  2. 6 2
      Data/SCargot/General.hs

+ 49 - 0
Data/SCargot/Basic.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Data.SCargot.Basic
+  ( basicSpec
+  , asRich
+  , asWellFormed
+  , addReader
+  , setComment
+  , withSemicolonComments
+  , withQuote
+  ) where
+
+import           Data.Char (isAlphaNum)
+import           Data.Attoparsec.Text (Parser, takeWhile1)
+import           Data.Text (Text)
+
+import           Data.SCargot.Repr.Basic
+import           Data.SCargot.General hiding (withQuote)
+
+isAtomChar :: Char -> Bool
+isAtomChar c = isAlphaNum c
+               || c == '-'
+               || c == '*'
+               || c == '/'
+               || c == '+'
+               || c == '<'
+               || c == '>'
+               || c == '='
+               || c == '!'
+               || c == '?'
+
+-- | A 'SExprSpec' that understands atoms to be sequences of
+--   alphanumeric characters as well as the punctuation
+--   characters @-*/+<>=!?@, and does no processing of them.
+--   This is not quite representative of actual lisps, which
+--   would (for example) accept various kinds of string
+--   literals. This should be sufficient for most ad-hoc
+--   storage or configuration formats.
+basicSpec :: SExprSpec Text (SExpr Text)
+basicSpec = mkSpec (takeWhile1 isAtomChar) id
+
+-- | Add the ability to understand a quoted S-Expression.
+--   This means that @'sexpr@ becomes sugar for
+--   @(quote sexpr)@. This is a variation on the identically-named
+--   function in Data.SCargot.General that has been specialized
+--   for the Basic atom type.
+withQuote :: SExprSpec Text a -> SExprSpec Text a
+withQuote = addReader '\'' (fmap go)
+  where go s = SCons (SAtom "quote") (SCons s SNil)

+ 6 - 2
Data/SCargot/General.hs

@@ -32,6 +32,7 @@ import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
 import           Data.Monoid ((<>))
 import           Data.Text (Text, pack, unpack)
+import qualified Data.Text as T
 
 import           Prelude hiding (takeWhile)
 
@@ -250,5 +251,8 @@ encodeSExpr (SCons x xs) t = go xs (encodeSExpr x t)
 
 -- | Emit an S-Expression in a machine-readable way. This does no
 --   pretty-printing or indentation, and produces no comments.
-encode :: SExprSpec atom carrier -> carrier -> Text
-encode SExprSpec { .. } c = encodeSExpr (preserial c) sesSAtom
+encodeOne :: SExprSpec atom carrier -> carrier -> Text
+encodeOne SExprSpec { .. } c = encodeSExpr (preserial c) sesSAtom
+
+encode :: SExprSpec atom carrier -> [carrier] -> Text
+encode spec cs = T.concat (map (encodeOne spec) cs)