Browse Source

Added all utility functions in all Repr modules with (terse) documentation

Getty Ritter 10 years ago
parent
commit
56aaebed19
3 changed files with 109 additions and 45 deletions
  1. 41 18
      Data/SCargot/Repr/Basic.hs
  2. 48 15
      Data/SCargot/Repr/Rich.hs
  3. 20 12
      Data/SCargot/Repr/WellFormed.hs

+ 41 - 18
Data/SCargot/Repr/Basic.hs

@@ -10,6 +10,12 @@ module Data.SCargot.Repr.Basic
          -- * Useful processing functions
        , fromPair
        , fromList
+       , fromAtom
+       , asPair
+       , asList
+       , isAtom
+       , asAtom
+       , asAssoc
        ) where
 
 import Control.Applicative ((<$>), (<*>), pure)
@@ -24,38 +30,55 @@ pattern A x = SAtom x
 -- | A (slightly) shorter alias for `SNil`
 pattern Nil = SNil
 
-
-type S t = R.SExpr t
-type Parse t a = R.SExpr t -> Either String a
-
 -- | Utility function for parsing a pair of things.
-fromPair :: Parse t a -> Parse t b -> Parse t (a, b)
+fromPair :: (SExpr t -> Either String a)
+         -> (SExpr t -> Either String b)
+         -> SExpr t -> Either String (a, b)
 fromPair pl pr (l ::: r ::: Nil) = (,) <$> pl l <*> pr r
-fromPair _  _  sx = fail ("Expected two-element list")
+fromPair _  _  sx = Left ("Expected two-element list")
 
 -- | Utility function for parsing a list of things.
-fromList :: Parse t a -> Parse t [a]
+fromList :: (SExpr t -> Either String a) -> SExpr t -> Either String [a]
 fromList p (s ::: ss) = (:) <$> p s <*> fromList p ss
 fromList p Nil        = pure []
-fromList _ sx         = fail ("Expected list")
+fromList _ sx         = Left ("Expected list")
 
-gatherList :: S t -> Either String [S t]
+-- | Utility function for parsing a single atom
+fromAtom :: SExpr t -> Either String t
+fromAtom (A a) = return a
+fromAtom _     = Left "Expected atom; found list"
+
+gatherList :: SExpr t -> Either String [SExpr t]
 gatherList (x ::: xs) = (:) <$> pure x <*> gatherList xs
 gatherList Nil        = pure []
-gatherList sx         = fail ("Expected list")
+gatherList sx         = Left ("Expected list")
 
-asPair :: ((S t, S t) -> Either String a) -> S t -> Either String a
+-- | Parse a two-element list (NOT a dotted pair) using the
+--   provided function.
+asPair :: ((SExpr t, SExpr t) -> Either String a)
+       -> SExpr t -> Either String a
 asPair f (l ::: r ::: SNil) = f (l, r)
-asPair _ sx = fail ("Expected two-element list")
+asPair _ sx = Left ("Expected two-element list")
 
-asList :: ([S t] -> Either String a) -> S t -> Either String a
+-- | Parse an arbitrary-length list using the provided function.
+asList :: ([SExpr t] -> Either String a) -> SExpr t -> Either String a
 asList f ls = gatherList ls >>= f
 
-asSymbol :: (t -> Either String a) -> S t -> Either String a
-asSymbol f (A s) = f s
-asSymbol _ sx    = fail ("Expected symbol")
+-- | Match a given literal atom, failing otherwise.
+isAtom :: Eq t => t -> SExpr t -> Either String ()
+isAtom s (A s')
+  | s == s'   = return ()
+  | otherwise = Left ".."
+isAtom _ _ = Left ".."
+
+-- | Parse an atom using the provided function.
+asAtom :: (t -> Either String a) -> SExpr t -> Either String a
+asAtom f (A s) = f s
+asAtom _ sx    = Left ("Expected symbol")
 
-asAssoc :: ([(S t, S t)] -> Either String a) -> S t -> Either String a
+-- | Parse an assoc-list using the provided function.
+asAssoc :: ([(SExpr t, SExpr t)] -> Either String a)
+        -> SExpr t -> Either String a
 asAssoc f ss = gatherList ss >>= mapM go >>= f
   where go (a ::: b ::: Nil) = return (a, b)
-        go sx = fail ("Expected two-element list")
+        go sx = Left ("Expected two-element list")

+ 48 - 15
Data/SCargot/Repr/Rich.hs

@@ -14,6 +14,12 @@ module Data.SCargot.Repr.Rich
          -- * Useful processing functions
        , fromPair
        , fromList
+       , fromAtom
+       , asPair
+       , asList
+       , isAtom
+       , asAtom
+       , asAssoc
        ) where
 
 import Control.Applicative ((<$>), (<*>), pure)
@@ -35,32 +41,59 @@ pattern DL xs x = R.RSDotted xs x
 -- | A shorter alias for `RSList []`
 pattern Nil = R.RSList []
 
-type S t = R.RichSExpr t
-type Parse t a = S t -> Either String a
-
 -- | Utility function for parsing a pair of things.
-fromPair :: Parse t a -> Parse t b -> Parse t (a, b)
+fromPair :: (RichSExpr t -> Either String a)
+         -> (RichSExpr t -> Either String b)
+         -> RichSExpr t -> Either String (a, b)
 fromPair pl pr = asPair $ \(l,r) -> (,) <$> pl l <*> pr r
 
 -- | Utility function for parsing a list of things.
-fromList :: Parse t a -> Parse t [a]
+fromList :: (RichSExpr t -> Either String a) -> RichSExpr t -> Either String [a]
 fromList p = asList $ \ss -> mapM p ss
 
-asPair :: ((S t, S t) -> Either String a) -> S t -> Either String a
+-- | Utility function for parsing a single atom
+fromAtom :: RichSExpr t -> Either String t
+fromAtom (L _) = Left "Expected atom; found list"
+fromAtom (A a) = return a
+
+-- | RichSExpr a -> Either String two-element list (NOT a dotted pair) using the
+--   provided function.
+asPair :: ((RichSExpr t, RichSExpr t) -> Either String a)
+       -> RichSExpr t -> Either String a
 asPair f (L [l, r]) = f (l, r)
-asPair _ sx         = fail ("Expected two-element list")
+asPair _ sx         = Left ("Expected two-element list")
 
-asList :: ([S t] -> Either String a) -> S t -> Either String a
+-- | Parse an arbitrary-length list using the provided function.
+asList :: ([RichSExpr t] -> Either String a)
+       -> RichSExpr t -> Either String a
 asList f (L ls) = f ls
-asList _ sx     = fail ("Expected list")
+asList _ sx     = Left ("Expected list")
+
+-- | Match a given literal atom, failing otherwise.
+isAtom :: Eq t => t -> RichSExpr t -> Either String ()
+isAtom s (A s')
+  | s == s'   = return ()
+  | otherwise = Left ".."
+isAtom _ _  = Left ".."
 
-asSymbol :: (t -> Either String a) -> S t -> Either String a
-asSymbol f (A s) = f s
-asSymbol _ sx    = fail ("Expected symbol")
+-- | Parse an atom using the provided function.
+asAtom :: (t -> Either String a) -> RichSExpr t -> Either String a
+asAtom f (A s) = f s
+asAtom _ sx    = Left ("Expected atom; got list")
 
-asAssoc :: ([(S t, S t)] -> Either String a) -> S t -> Either String a
+-- | Parse an assoc-list using the provided function.
+asAssoc :: Show t => ([(RichSExpr t, RichSExpr t)] -> Either String a)
+        -> RichSExpr t -> Either String a
 asAssoc f (L ss) = gatherPairs ss >>= f
   where gatherPairs (L [a, b] : ss) = (:) <$> pure (a, b) <*> gatherPairs ss
         gatherPairs []              = pure []
-        gatherPairs _               = fail "..."
-asAssoc _ sx     = fail ("Expected assoc list")
+        gatherPairs _               = Left "..."
+asAssoc _ sx     = Left ("Expected assoc list; got " ++ show sx)
+
+car :: (RichSExpr t -> Either String t') -> [RichSExpr t] -> Either String t'
+car f (x:_) = f x
+car _ []    = Left "car: Taking car of zero-element list"
+
+cdr :: ([RichSExpr t] -> Either String t') -> [RichSExpr t] -> Either String t'
+cdr f (_:xs) = f xs
+cdr _ []     = Left "cdr: Taking cdr of zero-element list"

+ 20 - 12
Data/SCargot/Repr/WellFormed.hs

@@ -43,48 +43,56 @@ type S t = R.WellFormedSExpr t
 type Parse t a = R.WellFormedSExpr t -> Either String a
 
 -- | Utility function for parsing a pair of things.
-fromPair :: Parse t a -> Parse t b -> Parse t (a, b)
+fromPair :: (WellFormedSExpr t -> Either String a)
+         -> (WellFormedSExpr t -> Either String b)
+         -> WellFormedSExpr t -> Either String (a, b)
 fromPair pl pr (L [l, r]) = (,) <$> pl l <*> pr r
 fromPair _  _  sx = Left ("Expected two-element list")
 
 -- | Utility function for parsing a list of things.
-fromList :: Parse t a -> Parse t [a]
+fromList :: (WellFormedSExpr t -> Either String a)
+         -> WellFormedSExpr t -> Either String [a]
 fromList p (L ss) = mapM p ss
 fromList _ sx     = Left ("Expected list")
 
-fromAtom :: Parse t t
+fromAtom :: WellFormedSExpr t -> Either String t
 fromAtom (L _) = Left "Expected atom; found list"
 fromAtom (A a) = return a
 
-asPair :: ((S t, S t) -> Either String a) -> S t -> Either String a
+asPair :: ((WellFormedSExpr t, WellFormedSExpr t) -> Either String a)
+       -> WellFormedSExpr t -> Either String a
 asPair f (L [l, r]) = f (l, r)
 asPair _ sx         = Left ("Expected two-element list")
 
-asList :: ([S t] -> Either String a) -> S t -> Either String a
+asList :: ([WellFormedSExpr t] -> Either String a)
+       -> WellFormedSExpr t -> Either String a
 asList f (L ls) = f ls
 asList _ sx     = Left ("Expected list")
 
-isAtom :: Eq t => t -> S t -> Either String ()
+isAtom :: Eq t => t -> WellFormedSExpr t -> Either String ()
 isAtom s (A s')
   | s == s'   = return ()
   | otherwise = Left ".."
 isAtom _ _  = Left ".."
 
-asAtom :: Show t => (t -> Either String a) -> S t -> Either String a
+asAtom :: (t -> Either String a) -> WellFormedSExpr t -> Either String a
 asAtom f (A s) = f s
-asAtom _ sx    = Left ("Expected atom; got" ++ show sx)
+asAtom _ sx    = Left ("Expected atom; got list")
 
-asAssoc :: Show t => ([(S t, S t)] -> Either String a) -> S t -> Either String a
+asAssoc :: ([(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a)
+        -> WellFormedSExpr t -> Either String a
 asAssoc f (L ss) = gatherPairs ss >>= f
   where gatherPairs (L [a, b] : ss) = (:) <$> pure (a, b) <*> gatherPairs ss
         gatherPairs []              = pure []
         gatherPairs _               = Left "..."
-asAssoc _ sx     = Left ("Expected assoc list; got " ++ show sx)
+asAssoc _ sx     = Left ("Expected assoc list")
 
-car :: (S t -> Either String t') -> [S t] -> Either String t'
+car :: (WellFormedSExpr t -> Either String t')
+    -> [WellFormedSExpr t] -> Either String t'
 car f (x:_) = f x
 car _ []    = Left "car: Taking car of zero-element list"
 
-cdr :: ([S t] -> Either String t') -> [S t] -> Either String t'
+cdr :: ([WellFormedSExpr t] -> Either String t')
+    -> [WellFormedSExpr t] -> Either String t'
 cdr f (_:xs) = f xs
 cdr _ []     = Left "cdr: Taking cdr of zero-element list"