Started to stub out generic interface (including spec interface)
Getty Ritter
10 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 |