Started to stub out generic interface (including spec interface)
Getty Ritter
9 years ago
1 | 1 | module Data.SExpression.General where |
2 | ||
3 | import Control.Applicative | |
4 | import Data.Attoparsec.Text | |
5 | import Data.Map.String (Map) | |
6 | import qualified Data.Map.String as M | |
7 | ||
8 | type ReaderMacroMap atom = Map Char (Reader atom) | |
9 | type Reader atom = (Parser (SExpr atom) -> Parser (SExpr atom)) | |
10 | type Serializer atom = atom -> Text | |
11 | ||
12 | -- | A 'SExprSpec' describes a parser and emitter for a particular | |
13 | -- variant of S-Expressions. The @atom@ type corresponds to a | |
14 | -- Haskell type used to represent the atoms, and the @carrier@ | |
15 | -- type corresponds to the parsed S-Expression structure. This | |
16 | -- is deliberately opaque so that it must be constructed and | |
17 | -- modified with other helper functions. | |
18 | data SExprSpec atom carrier = SExprSpec | |
19 | { sesPAtom :: Parser atom | |
20 | , sesSAtom :: Serializer atom | |
21 | , rmMap :: ReaderMacroMap atom | |
22 | , postparse :: SExpr atom -> Either String carrier | |
23 | , preserial :: carrier -> SExpr atom | |
24 | } | |
25 | ||
26 | -- | This creates a basic 'SExprSpec' when given a parser and serializer | |
27 | -- for an atom type. | |
28 | mkSpec :: Parser atom -> Serializer atom -> SExprSpec atom (SExpr atom) | |
29 | mkSpec p s = SExprSpec | |
30 | { sesPAtom = p | |
31 | , sesSAtom = s | |
32 | , rmMap = M.empty | |
33 | , postparse = return | |
34 | , preserial = id | |
35 | } | |
36 | ||
37 | -- | This is used to modify the carrier type for a 'SExprSpec'. This is | |
38 | -- used internally to convert between various 'SExpr' representations, | |
39 | -- but could also be used externally to add an extra conversion layer | |
40 | -- onto a 'SExprSpec', e.g. for a custom Lisp-like language: | |
41 | -- | |
42 | -- > mySpec :: SExprSpec MyAtomType MyAST | |
43 | -- > mySpec = convertSpec sexprToMyAST myASTToSexpr spec | |
44 | -- > where spec = mkSpec myParser mySerializer | |
45 | convertSpec :: (b -> Either String c) -> (c -> b) -> SExprSpec a b -> SExprSpec a c | |
46 | convertSpec f g spec = spec | |
47 | { postparse = postparse spec >=> f | |
48 | , preserial = g . preserial spec | |
49 | } | |
50 | ||
51 | addReader :: Char -> Reader a -> SExprSpec a c -> SExprSpec a c | |
52 | addReader c reader spec = spec { rmMap = insert c reader (rmMap spec) } | |
53 | ||
54 | quote :: atom -> Reader atom | |
55 | quote q parse = go <$> parse | |
56 | where go v = SCons q (SCons v SNil) | |
57 | ||
58 | toRich :: SExprSpec a (SExpr b) -> SExprSpec a (RichSExpr b) | |
59 | toRich = convertSpec (return . toRich) fromRich | |
60 | ||
61 | toWellFormed :: SExprSpec a (SExpr b) -> SExprSpec a (WellFormedSExpr b) | |
62 | toWellFormed = convertSpec toWellFormed fromWellFormed | |
63 | ||
64 | parseGenericSExpr :: Parser atom -> ReaderMacroMap atom -> Parser (SExpr atom) | |
65 | ||
66 | -- | | |
67 | parseSExpr :: SExprSpec atom carrier -> Text -> Either String carrier | |
68 | parseSExpr spec = undefined | |
69 | ||
70 | -- | blah | |
71 | serializeSExpr :: SExprSpec atom carrier -> carrier -> Text | |
72 | serializeSExpr spec = serializeGenericSExpr ses . preserial |