gdritter repos s-cargot / ba4f212
Improving docs on Rich repr Getty Ritter 9 years ago
1 changed file(s) with 69 addition(s) and 12 deletion(s). Collapse all Expand all
2121 , asPair
2222 , asList
2323 , isAtom
24 , isNil
2425 , asAtom
2526 , asAssoc
2627 ) where
2930 import Data.SCargot.Repr as R
3031
3132 -- | A traversal with access to the first element of a pair.
33 --
34 -- >>> set _car (A "elephant") (L [A "one", A "two", A "three"])
35 -- L [A "elelphant",A "two",A "three"]
3236 _car :: Applicative f => (RichSExpr a -> f (RichSExpr a)) -> RichSExpr a -> f (RichSExpr a)
3337 _car f (L (x:xs)) = (\ x -> L (x:xs)) `fmap` f x
3438 _car f (DL (x:xs) a) = (\ x -> DL (x:xs) a) `fmap` f x
3640 _car _ Nil = pure Nil
3741
3842 -- | A traversal with access to the second element of a pair.
43 --
44 -- >>> set _car (A "elephant") (L [A "one", A "two", A "three"])
45 -- DL [A "one"] "elephant"
3946 _cdr :: Applicative f => (RichSExpr a -> f (RichSExpr a)) -> RichSExpr a -> f (RichSExpr a)
4047 _cdr f (L (x:xs)) =
4148 let go Nil = L [x]
6875 -- | A shorter alias for `RSDotted`
6976 pattern DL xs x = R.RSDotted xs x
7077
71 -- | A shorter alias for `RSList []`
78 -- | A shorter alias for `RSList` @[]@
7279 pattern Nil = R.RSList []
7380
74 -- | Utility function for parsing a pair of things.
81 -- | Utility function for parsing a pair of things: this parses a two-element list,
82 -- and not a cons pair.
83 --
84 -- >>> fromPair (isAtom "pachy") (asAtom return) (L [A "pachy", A "derm"])
85 -- Right ((), "derm")
86 -- >>> fromPair (isAtom "pachy") fromAtom (L [A "pachy"])
87 -- Left "Expected two-element list"
7588 fromPair :: (RichSExpr t -> Either String a)
7689 -> (RichSExpr t -> Either String b)
7790 -> RichSExpr t -> Either String (a, b)
7891 fromPair pl pr = asPair $ \(l,r) -> (,) <$> pl l <*> pr r
7992
80 -- | Utility function for parsing a list of things.
93 -- | Utility function for parsing a proper list of things.
94 --
95 -- >>> fromList fromAtom (L [A "this", A "that", A "the-other"])
96 -- Right ["this","that","the-other"]
97 -- >>> fromList fromAtom (DL [A "this", A "that"] "the-other"])
98 -- Left "asList: expected proper list; found dotted list"
8199 fromList :: (RichSExpr t -> Either String a) -> RichSExpr t -> Either String [a]
82100 fromList p = asList $ \ss -> mapM p ss
83101
84102 -- | Utility function for parsing a single atom
103 --
104 -- >>> fromAtom (A "elephant")
105 -- Right "elephant"
106 -- >>> fromAtom (L [A "elephant"])
107 -- Left "fromAtom: expected atom; found list"
85108 fromAtom :: RichSExpr t -> Either String t
86 fromAtom (L _) = Left "Expected atom; found list"
87 fromAtom (A a) = return a
109 fromAtom (L _) = Left "fromAtom: expected atom; found list"
110 fromAtom (DL _ _) = Left "fromAtom: expected atom; found dotted list"
111 fromAtom (A a) = return a
88112
89 -- | RichSExpr a -> Either String two-element list (NOT a dotted pair) using the
90 -- provided function.
113 -- | Parses a two -element list using the provided function.
114 --
115 -- >>> let go (A l) (A r) = return (l ++ r); go _ _ = Left "expected atoms"
116 -- >>> asPair go (L [A "pachy", A "derm"])
117 -- Right "pachyderm"
118 -- >>> asPair go (L [A "elephant"])
119 -- Left "asPair: expected two-element list; found list of length 1"
91120 asPair :: ((RichSExpr t, RichSExpr t) -> Either String a)
92121 -> RichSExpr t -> Either String a
93122 asPair f (L [l, r]) = f (l, r)
94 asPair _ sx = Left ("Expected two-element list")
123 asPair _ (L ls) = Left ("asPair: expected two-element list; found list of lenght " ++ show (length ls))
124 asPair _ DL {} = Left ("asPair: expected two-element list; found dotted list")
125 asPair _ A {} = Left ("asPair: expected two-element list; found atom")
95126
96127 -- | Parse an arbitrary-length list using the provided function.
97128 asList :: ([RichSExpr t] -> Either String a)
98129 -> RichSExpr t -> Either String a
99130 asList f (L ls) = f ls
100 asList _ sx = Left ("Expected list")
131 asList _ DL {} = Left ("asList: expected list; found dotted list")
132 asList _ A { } = Left ("asList: expected list; found dotted list")
101133
102134 -- | Match a given literal atom, failing otherwise.
135 --
136 -- >>> isAtom "elephant" (A "elephant")
137 -- Right ()
138 -- >>> isAtom "elephant" (L [A "elephant"])
139 -- Left "isAtom: expected atom; found list"
103140 isAtom :: Eq t => t -> RichSExpr t -> Either String ()
104141 isAtom s (A s')
105142 | s == s' = return ()
106 | otherwise = Left ".."
107 isAtom _ _ = Left ".."
143 | otherwise = Left "isAtom: failed to match atom"
144 isAtom _ L {} = Left "isAtom: expected atom; found list"
145 isAtom _ DL {} = Left "isAtom: expected atom; found dotted list"
146
147 -- | Match an empty list, failing otherwise.
148 --
149 -- >>> isNil (L [])
150 -- Right ()
151 -- >>> isNil (A "elephant")
152 -- Left "isNil: expected nil; found atom"
153 isNil :: RichSExpr t -> Either String ()
154 isNil Nil = return ()
155 isNil L {} = Left "isNil: expected nil; found non-nil list"
156 isNil DL {} = Left "isNil: expected nil; found dotted list"
157 isNil A {} = Left "isNil: expected nil; found atom"
108158
109159 -- | Parse an atom using the provided function.
160 --
161 -- >>> import Data.Char (toUpper)
162 -- >>> asAtom (return . map toUpper) (A "elephant")
163 -- Right "ELEPHANT"
164 -- >>> asAtom (return . map toUpper) (L [])
165 -- Left "asAtom: expected atom; found list"
110166 asAtom :: (t -> Either String a) -> RichSExpr t -> Either String a
111167 asAtom f (A s) = f s
112 asAtom _ sx = Left ("Expected atom; got list")
168 asAtom _ L {} = Left ("asAtom: expected atom; found list")
169 asAtom _ DL {} = Left ("asAtom: expected atom; found dotted list")
113170
114171 -- | Parse an assoc-list using the provided function.
115172 asAssoc :: Show t => ([(RichSExpr t, RichSExpr t)] -> Either String a)