Added docs to WellFormed repr and did a few fixes in Rich

Data/SCargot/Repr/Rich.hs

@@ -119,7 +119,7 @@ fromAtom (L _)    = Left "fromAtom: expected atom; found list"
 fromAtom (DL _ _) = Left "fromAtom: expected atom; found dotted list"
 fromAtom (A a)    = return a
 
+-- | Parses a two-element list using the provided function.
 --
 -- >>> let go (A l) (A r) = return (l ++ r); go _ _ = Left "expected atoms"
 -- >>> asPair go (L [A "pachy", A "derm"])

Data/SCargot/Repr/WellFormed.hs

@@ -36,62 +36,131 @@ pattern L xs = R.WFSList xs
 -- | A shorter alias for `WFSAtom`
 pattern A a  = R.WFSAtom a
 
+-- | A shorter alias for `WFSList` @[]@
 pattern Nil = R.WFSList []
 
-type S t = R.WellFormedSExpr t
-type Parse t a = R.WellFormedSExpr t -> Either String a
+getShape :: WellFormedSExpr a -> String
+getShape A {}   = "atom"
+getShape Nil    = "empty list"
+getShape (L sx) = "list of length " ++ show (length sx)
 
 -- | Utility function for parsing a pair of things.
+--
+-- >>> fromPair (isAtom "pachy") (asAtom return) (L [A "pachy", A "derm"])
+-- Right ((), "derm")
+-- >>> fromPair (isAtom "pachy") fromAtom (L [A "pachy"])
+-- Left "Expected two-element list"
 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")
+fromPair _  _  sx = Left ("fromPair: expected two-element list; found " ++ getShape sx)
 
 -- | Utility function for parsing a list of things.
+--
+-- >>> fromList fromAtom (L [A "this", A "that", A "the-other"])
+-- Right ["this","that","the-other"]
+-- >>> fromList fromAtom (A "pachyderm")
+-- Left "asList: expected proper list; found dotted list"
 fromList :: (WellFormedSExpr t -> Either String a)
          -> WellFormedSExpr t -> Either String [a]
 fromList p (L ss) = mapM p ss
-fromList _ sx     = Left ("Expected list")
-
+fromList _ sx     = Left ("fromList: expected list; found " ++ getShape sx)
+
+-- | Utility function for parsing a single atom
+--
+-- >>> fromAtom (A "elephant")
+-- Right "elephant"
+-- >>> fromAtom (L [A "elephant"])
+-- Left "fromAtom: expected atom; found list"
 fromAtom :: WellFormedSExpr t -> Either String t
-fromAtom (L _) = Left "Expected atom; found list"
 fromAtom (A a) = return a
-
+fromAtom sx    = Left ("fromAtom: expected atom; found " ++ getShape sx)
+
+-- | Parses a two-element list using the provided function.
+--
+-- >>> let go (A l) (A r) = return (l ++ r); go _ _ = Left "expected atoms"
+-- >>> asPair go (L [A "pachy", A "derm"])
+-- Right "pachyderm"
+-- >>> asPair go (L [A "elephant"])
+-- Left "asPair: expected two-element list; found list of length 1"
 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")
-
+asPair _ sx         = Left ("asPair: expected two-element list; found " ++ getShape sx)
+
+-- | Parse an arbitrary-length list using the provided function.
+--
+-- >>> let go xs = concat <$> mapM fromAtom xs
+-- >>> asList go (L [A "el", A "eph", A "ant"])
+-- Right "elephant"
+-- >>> asList go (A "pachyderm")
+-- Left "asList: expected list; found atom"
 asList :: ([WellFormedSExpr t] -> Either String a)
        -> WellFormedSExpr t -> Either String a
 asList f (L ls) = f ls
-asList _ sx     = Left ("Expected list")
-
+asList _ sx     = Left ("asList: expected list; found " ++ getShape sx)
+
+-- | Match a given literal atom, failing otherwise.
+--
+-- >>> isAtom "elephant" (A "elephant")
+-- Right ()
+-- >>> isAtom "elephant" (L [A "elephant"])
+-- Left "isAtom: expected atom; found list"
 isAtom :: Eq t => t -> WellFormedSExpr t -> Either String ()
 isAtom s (A s')
   | s == s'   = return ()
-  | otherwise = Left ".."
-isAtom _ _  = Left ".."
-
+  | otherwise = Left "isAtom: failed to match atom"
+isAtom _ sx  = Left ("isAtom: expected atom; found " ++ getShape sx)
+
+-- | Match an empty list, failing otherwise.
+--
+-- >>> isNil (L [])
+-- Right ()
+-- >>> isNil (A "elephant")
+-- Left "isNil: expected nil; found atom"
+isNil :: WellFormedSExpr t -> Either String ()
+isNil Nil = return ()
+isNil sx  = Left ("isNil: expected nil; found " ++ getShape sx)
+
+-- | Parse an atom using the provided function.
+--
+-- >>> import Data.Char (toUpper)
+-- >>> asAtom (return . map toUpper) (A "elephant")
+-- Right "ELEPHANT"
+-- >>> asAtom (return . map toUpper) (L [])
+-- Left "asAtom: expected atom; found list"
 asAtom :: (t -> Either String a) -> WellFormedSExpr t -> Either String a
 asAtom f (A s) = f s
-asAtom _ sx    = Left ("Expected atom; got list")
-
+asAtom _ sx    = Left ("asAtom: expected atom; found " ++ getShape sx)
+
+-- | Parse an assoc-list using the provided function.
+--
+-- >>> let def (x, y) = do { a <- fromAtom x; b <- fromAtom y; return (a ++ ": " ++ b) }
+-- >>> let defList xs = do { defs <- mapM def xs; return (unlines defs) }
+-- >>> asAssoc defList (L [ L [A "legs", A "four"], L [ A "trunk", A "one"] ])
+-- Right "legs: four\ntrunk: one\n"
+-- >>> asAssoc defList (L [ L [A "legs", A "four"], L [ A "elephant"] ])
+-- Left "asAssoc: expected pair; found list of length 1"
 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")
+        gatherPairs (sx:_)          = Left ("asAssoc: expected pair; found " ++ getShape sx)
+asAssoc _ sx     = Left ("asAssoc: expected list; found " ++ getShape sx)
 
+-- | Run the parser on the first element of a Haskell list of "WellFormedSExpr" values,
+--   failing if the list is empty. This is useful in conjunction with the `asList`
+--   function.
 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"
 
+-- | Run the parser on all but the first element of a Haskell list of "WellFormedSExpr" values,
+--   failing if the list is empty. This is useful in conjunction with the `asList`
+--   function.
 cdr :: ([WellFormedSExpr t] -> Either String t')
     -> [WellFormedSExpr t] -> Either String t'
 cdr f (_:xs) = f xs