gdritter repos s-cargot / 65680e2
Added docs to WellFormed repr and did a few fixes in Rich Getty Ritter 9 years ago
2 changed file(s) with 83 addition(s) and 14 deletion(s). Collapse all Expand all
+1
-1
Data/SCargot/Repr/Rich.hs less more
119119 fromAtom (DL _ _) = Left "fromAtom: expected atom; found dotted list"
120120 fromAtom (A a) = return a
121121
122 -- | Parses a two -element list using the provided function.
122 -- | Parses a two-element list using the provided function.
123123 --
124124 -- >>> let go (A l) (A r) = return (l ++ r); go _ _ = Left "expected atoms"
125125 -- >>> asPair go (L [A "pachy", A "derm"])
+82
-13
Data/SCargot/Repr/WellFormed.hs less more
3636 -- | A shorter alias for `WFSAtom`
3737 pattern A a = R.WFSAtom a
3838
39 -- | A shorter alias for `WFSList []`
39 -- | A shorter alias for `WFSList` @[]@
4040 pattern Nil = R.WFSList []
4141
42 type S t = R.WellFormedSExpr t
43 type Parse t a = R.WellFormedSExpr t -> Either String a
42 getShape :: WellFormedSExpr a -> String
43 getShape A {} = "atom"
44 getShape Nil = "empty list"
45 getShape (L sx) = "list of length " ++ show (length sx)
4446
4547 -- | Utility function for parsing a pair of things.
48 --
49 -- >>> fromPair (isAtom "pachy") (asAtom return) (L [A "pachy", A "derm"])
50 -- Right ((), "derm")
51 -- >>> fromPair (isAtom "pachy") fromAtom (L [A "pachy"])
52 -- Left "Expected two-element list"
4653 fromPair :: (WellFormedSExpr t -> Either String a)
4754 -> (WellFormedSExpr t -> Either String b)
4855 -> WellFormedSExpr t -> Either String (a, b)
4956 fromPair pl pr (L [l, r]) = (,) <$> pl l <*> pr r
50 fromPair _ _ sx = Left ("Expected two-element list")
57 fromPair _ _ sx = Left ("fromPair: expected two-element list; found " ++ getShape sx)
5158
5259 -- | Utility function for parsing a list of things.
60 --
61 -- >>> fromList fromAtom (L [A "this", A "that", A "the-other"])
62 -- Right ["this","that","the-other"]
63 -- >>> fromList fromAtom (A "pachyderm")
64 -- Left "asList: expected proper list; found dotted list"
5365 fromList :: (WellFormedSExpr t -> Either String a)
5466 -> WellFormedSExpr t -> Either String [a]
5567 fromList p (L ss) = mapM p ss
56 fromList _ sx = Left ("Expected list")
68 fromList _ sx = Left ("fromList: expected list; found " ++ getShape sx)
5769
70 -- | Utility function for parsing a single atom
71 --
72 -- >>> fromAtom (A "elephant")
73 -- Right "elephant"
74 -- >>> fromAtom (L [A "elephant"])
75 -- Left "fromAtom: expected atom; found list"
5876 fromAtom :: WellFormedSExpr t -> Either String t
59 fromAtom (L _) = Left "Expected atom; found list"
6077 fromAtom (A a) = return a
78 fromAtom sx = Left ("fromAtom: expected atom; found " ++ getShape sx)
6179
80 -- | Parses a two-element list using the provided function.
81 --
82 -- >>> let go (A l) (A r) = return (l ++ r); go _ _ = Left "expected atoms"
83 -- >>> asPair go (L [A "pachy", A "derm"])
84 -- Right "pachyderm"
85 -- >>> asPair go (L [A "elephant"])
86 -- Left "asPair: expected two-element list; found list of length 1"
6287 asPair :: ((WellFormedSExpr t, WellFormedSExpr t) -> Either String a)
6388 -> WellFormedSExpr t -> Either String a
6489 asPair f (L [l, r]) = f (l, r)
65 asPair _ sx = Left ("Expected two-element list")
90 asPair _ sx = Left ("asPair: expected two-element list; found " ++ getShape sx)
6691
92 -- | Parse an arbitrary-length list using the provided function.
93 --
94 -- >>> let go xs = concat <$> mapM fromAtom xs
95 -- >>> asList go (L [A "el", A "eph", A "ant"])
96 -- Right "elephant"
97 -- >>> asList go (A "pachyderm")
98 -- Left "asList: expected list; found atom"
6799 asList :: ([WellFormedSExpr t] -> Either String a)
68100 -> WellFormedSExpr t -> Either String a
69101 asList f (L ls) = f ls
70 asList _ sx = Left ("Expected list")
102 asList _ sx = Left ("asList: expected list; found " ++ getShape sx)
71103
104 -- | Match a given literal atom, failing otherwise.
105 --
106 -- >>> isAtom "elephant" (A "elephant")
107 -- Right ()
108 -- >>> isAtom "elephant" (L [A "elephant"])
109 -- Left "isAtom: expected atom; found list"
72110 isAtom :: Eq t => t -> WellFormedSExpr t -> Either String ()
73111 isAtom s (A s')
74112 | s == s' = return ()
75 | otherwise = Left ".."
76 isAtom _ _ = Left ".."
113 | otherwise = Left "isAtom: failed to match atom"
114 isAtom _ sx = Left ("isAtom: expected atom; found " ++ getShape sx)
77115
116 -- | Match an empty list, failing otherwise.
117 --
118 -- >>> isNil (L [])
119 -- Right ()
120 -- >>> isNil (A "elephant")
121 -- Left "isNil: expected nil; found atom"
122 isNil :: WellFormedSExpr t -> Either String ()
123 isNil Nil = return ()
124 isNil sx = Left ("isNil: expected nil; found " ++ getShape sx)
125
126 -- | Parse an atom using the provided function.
127 --
128 -- >>> import Data.Char (toUpper)
129 -- >>> asAtom (return . map toUpper) (A "elephant")
130 -- Right "ELEPHANT"
131 -- >>> asAtom (return . map toUpper) (L [])
132 -- Left "asAtom: expected atom; found list"
78133 asAtom :: (t -> Either String a) -> WellFormedSExpr t -> Either String a
79134 asAtom f (A s) = f s
80 asAtom _ sx = Left ("Expected atom; got list")
135 asAtom _ sx = Left ("asAtom: expected atom; found " ++ getShape sx)
81136
137 -- | Parse an assoc-list using the provided function.
138 --
139 -- >>> let def (x, y) = do { a <- fromAtom x; b <- fromAtom y; return (a ++ ": " ++ b) }
140 -- >>> let defList xs = do { defs <- mapM def xs; return (unlines defs) }
141 -- >>> asAssoc defList (L [ L [A "legs", A "four"], L [ A "trunk", A "one"] ])
142 -- Right "legs: four\ntrunk: one\n"
143 -- >>> asAssoc defList (L [ L [A "legs", A "four"], L [ A "elephant"] ])
144 -- Left "asAssoc: expected pair; found list of length 1"
82145 asAssoc :: ([(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a)
83146 -> WellFormedSExpr t -> Either String a
84147 asAssoc f (L ss) = gatherPairs ss >>= f
85148 where gatherPairs (L [a, b] : ss) = (:) <$> pure (a, b) <*> gatherPairs ss
86149 gatherPairs [] = pure []
87 gatherPairs _ = Left "..."
88 asAssoc _ sx = Left ("Expected assoc list")
150 gatherPairs (sx:_) = Left ("asAssoc: expected pair; found " ++ getShape sx)
151 asAssoc _ sx = Left ("asAssoc: expected list; found " ++ getShape sx)
89152
153 -- | Run the parser on the first element of a Haskell list of "WellFormedSExpr" values,
154 -- failing if the list is empty. This is useful in conjunction with the `asList`
155 -- function.
90156 car :: (WellFormedSExpr t -> Either String t')
91157 -> [WellFormedSExpr t] -> Either String t'
92158 car f (x:_) = f x
93159 car _ [] = Left "car: Taking car of zero-element list"
94160
161 -- | Run the parser on all but the first element of a Haskell list of "WellFormedSExpr" values,
162 -- failing if the list is empty. This is useful in conjunction with the `asList`
163 -- function.
95164 cdr :: ([WellFormedSExpr t] -> Either String t')
96165 -> [WellFormedSExpr t] -> Either String t'
97166 cdr f (_:xs) = f xs