Improving docs on Rich repr
Getty Ritter
10 years ago
| 21 | 21 | , asPair |
| 22 | 22 | , asList |
| 23 | 23 | , isAtom |
| 24 | , isNil | |
| 24 | 25 | , asAtom |
| 25 | 26 | , asAssoc |
| 26 | 27 | ) where |
| 29 | 30 | import Data.SCargot.Repr as R |
| 30 | 31 | |
| 31 | 32 | -- | 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"] | |
| 32 | 36 | _car :: Applicative f => (RichSExpr a -> f (RichSExpr a)) -> RichSExpr a -> f (RichSExpr a) |
| 33 | 37 | _car f (L (x:xs)) = (\ x -> L (x:xs)) `fmap` f x |
| 34 | 38 | _car f (DL (x:xs) a) = (\ x -> DL (x:xs) a) `fmap` f x |
| 36 | 40 | _car _ Nil = pure Nil |
| 37 | 41 | |
| 38 | 42 | -- | 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" | |
| 39 | 46 | _cdr :: Applicative f => (RichSExpr a -> f (RichSExpr a)) -> RichSExpr a -> f (RichSExpr a) |
| 40 | 47 | _cdr f (L (x:xs)) = |
| 41 | 48 | let go Nil = L [x] |
| 68 | 75 | -- | A shorter alias for `RSDotted` |
| 69 | 76 | pattern DL xs x = R.RSDotted xs x |
| 70 | 77 | |
| 71 |
-- | A shorter alias for `RSList |
|
| 78 | -- | A shorter alias for `RSList` @[]@ | |
| 72 | 79 | pattern Nil = R.RSList [] |
| 73 | 80 | |
| 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" | |
| 75 | 88 | fromPair :: (RichSExpr t -> Either String a) |
| 76 | 89 | -> (RichSExpr t -> Either String b) |
| 77 | 90 | -> RichSExpr t -> Either String (a, b) |
| 78 | 91 | fromPair pl pr = asPair $ \(l,r) -> (,) <$> pl l <*> pr r |
| 79 | 92 | |
| 80 |
-- | Utility function for parsing a |
|
| 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" | |
| 81 | 99 | fromList :: (RichSExpr t -> Either String a) -> RichSExpr t -> Either String [a] |
| 82 | 100 | fromList p = asList $ \ss -> mapM p ss |
| 83 | 101 | |
| 84 | 102 | -- | 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" | |
| 85 | 108 | 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 | |
| 88 | 112 | |
| 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" | |
| 91 | 120 | asPair :: ((RichSExpr t, RichSExpr t) -> Either String a) |
| 92 | 121 | -> RichSExpr t -> Either String a |
| 93 | 122 | asPair f (L [l, r]) = f (l, r) |
| 94 |
asPair _ |
|
| 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") | |
| 95 | 126 | |
| 96 | 127 | -- | Parse an arbitrary-length list using the provided function. |
| 97 | 128 | asList :: ([RichSExpr t] -> Either String a) |
| 98 | 129 | -> RichSExpr t -> Either String a |
| 99 | 130 | asList f (L ls) = f ls |
| 100 |
asList _ |
|
| 131 | asList _ DL {} = Left ("asList: expected list; found dotted list") | |
| 132 | asList _ A { } = Left ("asList: expected list; found dotted list") | |
| 101 | 133 | |
| 102 | 134 | -- | 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" | |
| 103 | 140 | isAtom :: Eq t => t -> RichSExpr t -> Either String () |
| 104 | 141 | isAtom s (A s') |
| 105 | 142 | | 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" | |
| 108 | 158 | |
| 109 | 159 | -- | 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" | |
| 110 | 166 | asAtom :: (t -> Either String a) -> RichSExpr t -> Either String a |
| 111 | 167 | asAtom f (A s) = f s |
| 112 |
asAtom _ |
|
| 168 | asAtom _ L {} = Left ("asAtom: expected atom; found list") | |
| 169 | asAtom _ DL {} = Left ("asAtom: expected atom; found dotted list") | |
| 113 | 170 | |
| 114 | 171 | -- | Parse an assoc-list using the provided function. |
| 115 | 172 | asAssoc :: Show t => ([(RichSExpr t, RichSExpr t)] -> Either String a) |