gdritter repos s-cargot / 6725553
Added Data.SCargot.Basic to demonstrate usage of naive sexpr encoding Getty Ritter 9 years ago
2 changed file(s) with 55 addition(s) and 2 deletion(s). Collapse all Expand all
1 {-# LANGUAGE OverloadedStrings #-}
2
3 module Data.SCargot.Basic
4 ( basicSpec
5 , asRich
6 , asWellFormed
7 , addReader
8 , setComment
9 , withSemicolonComments
10 , withQuote
11 ) where
12
13 import Data.Char (isAlphaNum)
14 import Data.Attoparsec.Text (Parser, takeWhile1)
15 import Data.Text (Text)
16
17 import Data.SCargot.Repr.Basic
18 import Data.SCargot.General hiding (withQuote)
19
20 isAtomChar :: Char -> Bool
21 isAtomChar c = isAlphaNum c
22 || c == '-'
23 || c == '*'
24 || c == '/'
25 || c == '+'
26 || c == '<'
27 || c == '>'
28 || c == '='
29 || c == '!'
30 || c == '?'
31
32 -- | A 'SExprSpec' that understands atoms to be sequences of
33 -- alphanumeric characters as well as the punctuation
34 -- characters @-*/+<>=!?@, and does no processing of them.
35 -- This is not quite representative of actual lisps, which
36 -- would (for example) accept various kinds of string
37 -- literals. This should be sufficient for most ad-hoc
38 -- storage or configuration formats.
39 basicSpec :: SExprSpec Text (SExpr Text)
40 basicSpec = mkSpec (takeWhile1 isAtomChar) id
41
42 -- | Add the ability to understand a quoted S-Expression.
43 -- This means that @'sexpr@ becomes sugar for
44 -- @(quote sexpr)@. This is a variation on the identically-named
45 -- function in Data.SCargot.General that has been specialized
46 -- for the Basic atom type.
47 withQuote :: SExprSpec Text a -> SExprSpec Text a
48 withQuote = addReader '\'' (fmap go)
49 where go s = SCons (SAtom "quote") (SCons s SNil)
3232 import qualified Data.Map.Strict as M
3333 import Data.Monoid ((<>))
3434 import Data.Text (Text, pack, unpack)
35 import qualified Data.Text as T
3536
3637 import Prelude hiding (takeWhile)
3738
250251
251252 -- | Emit an S-Expression in a machine-readable way. This does no
252253 -- pretty-printing or indentation, and produces no comments.
253 encode :: SExprSpec atom carrier -> carrier -> Text
254 encode SExprSpec { .. } c = encodeSExpr (preserial c) sesSAtom
254 encodeOne :: SExprSpec atom carrier -> carrier -> Text
255 encodeOne SExprSpec { .. } c = encodeSExpr (preserial c) sesSAtom
256
257 encode :: SExprSpec atom carrier -> [carrier] -> Text
258 encode spec cs = T.concat (map (encodeOne spec) cs)