Commit 56aaebed194410d40b9eb5e36666b2f2816aeb6b - s-cargot

Added all utility functions in all Repr modules with (terse) documentation Getty Ritter 10 years ago

3 changed file(s) with 109 addition(s) and 45 deletion(s). Collapse all Expand all

+41

-18

Data/SCargot/Repr/Basic.hs less more

10	10	-- * Useful processing functions
11	11	, fromPair
12	12	, fromList
	13	, fromAtom
	14	, asPair
	15	, asList
	16	, isAtom
	17	, asAtom
	18	, asAssoc
13	19	) where
14	20
15	21	import Control.Applicative ((<$>), (<*>), pure)

24	30	-- \| A (slightly) shorter alias for `SNil`
25	31	pattern Nil = SNil
26	32
27
28		type S t = R.SExpr t
29		type Parse t a = R.SExpr t -> Either String a
30
31	33	-- \| Utility function for parsing a pair of things.
32		fromPair :: ~~Parse t a -> Parse t b -> Parse t (a, b~~)
	34	fromPair :: (SExpr t -> Either String a)
	35	-> (SExpr t -> Either String b)
	36	-> SExpr t -> Either String (a, b)
33	37	fromPair pl pr (l ::: r ::: Nil) = (,) <$> pl l <*> pr r
34		fromPair _ _ sx = ~~fail~~ ("Expected two-element list")
	38	fromPair _ _ sx = Left ("Expected two-element list")
35	39
36	40	-- \| Utility function for parsing a list of things.
37		fromList :: ~~Parse t a -> Parse t~~ [a]
	41	fromList :: (SExpr t -> Either String a) -> SExpr t -> Either String [a]
38	42	fromList p (s ::: ss) = (:) <$> p s <*> fromList p ss
39	43	fromList p Nil = pure []
40		fromList _ sx = ~~fail~~ ("Expected list")
	44	fromList _ sx = Left ("Expected list")
41	45
42		gatherList :: S t -> Either String [S t]
	46	-- \| Utility function for parsing a single atom
	47	fromAtom :: SExpr t -> Either String t
	48	fromAtom (A a) = return a
	49	fromAtom _ = Left "Expected atom; found list"
	50
	51	gatherList :: SExpr t -> Either String [SExpr t]
43	52	gatherList (x ::: xs) = (:) <$> pure x <*> gatherList xs
44	53	gatherList Nil = pure []
45		gatherList sx = ~~fail~~ ("Expected list")
	54	gatherList sx = Left ("Expected list")
46	55
47		asPair :: ((S t, S t) -> Either String a) -> S t -> Either String a
	56	-- \| Parse a two-element list (NOT a dotted pair) using the
	57	-- provided function.
	58	asPair :: ((SExpr t, SExpr t) -> Either String a)
	59	-> SExpr t -> Either String a
48	60	asPair f (l ::: r ::: SNil) = f (l, r)
49		asPair _ sx = ~~fail~~ ("Expected two-element list")
	61	asPair _ sx = Left ("Expected two-element list")
50	62
51		asList :: ([S t] -> Either String a) -> S t -> Either String a
	63	-- \| Parse an arbitrary-length list using the provided function.
	64	asList :: ([SExpr t] -> Either String a) -> SExpr t -> Either String a
52	65	asList f ls = gatherList ls >>= f
53	66
54		asSymbol :: (t -> Either String a) -> S t -> Either String a
55		asSymbol f (A s) = f s
56		asSymbol _ sx = fail ("Expected symbol")
	67	-- \| Match a given literal atom, failing otherwise.
	68	isAtom :: Eq t => t -> SExpr t -> Either String ()
	69	isAtom s (A s')
	70	\| s == s' = return ()
	71	\| otherwise = Left ".."
	72	isAtom _ _ = Left ".."
57	73
58		asAssoc :: ([(S t, S t)] -> Either String a) -> S t -> Either String a
	74	-- \| Parse an atom using the provided function.
	75	asAtom :: (t -> Either String a) -> SExpr t -> Either String a
	76	asAtom f (A s) = f s
	77	asAtom _ sx = Left ("Expected symbol")
	78
	79	-- \| Parse an assoc-list using the provided function.
	80	asAssoc :: ([(SExpr t, SExpr t)] -> Either String a)
	81	-> SExpr t -> Either String a
59	82	asAssoc f ss = gatherList ss >>= mapM go >>= f
60	83	where go (a ::: b ::: Nil) = return (a, b)
61		go sx = ~~fail~~ ("Expected two-element list")
	84	go sx = Left ("Expected two-element list")

+48

-15

Data/SCargot/Repr/Rich.hs less more

14	14	-- * Useful processing functions
15	15	, fromPair
16	16	, fromList
	17	, fromAtom
	18	, asPair
	19	, asList
	20	, isAtom
	21	, asAtom
	22	, asAssoc
17	23	) where
18	24
19	25	import Control.Applicative ((<$>), (<*>), pure)

35	41	-- \| A shorter alias for `RSList []`
36	42	pattern Nil = R.RSList []
37	43
38		type S t = R.RichSExpr t
39		type Parse t a = S t -> Either String a
40
41	44	-- \| Utility function for parsing a pair of things.
42		fromPair :: ~~Parse t a -> Parse t b -> Parse t (a, b~~)
	45	fromPair :: (RichSExpr t -> Either String a)
	46	-> (RichSExpr t -> Either String b)
	47	-> RichSExpr t -> Either String (a, b)
43	48	fromPair pl pr = asPair $ \(l,r) -> (,) <$> pl l <*> pr r
44	49
45	50	-- \| Utility function for parsing a list of things.
46		fromList :: ~~Parse t a -> Parse t~~ [a]
	51	fromList :: (RichSExpr t -> Either String a) -> RichSExpr t -> Either String [a]
47	52	fromList p = asList $ \ss -> mapM p ss
48	53
49		asPair :: ((S t, S t) -> Either String a) -> S t -> Either String a
	54	-- \| Utility function for parsing a single atom
	55	fromAtom :: RichSExpr t -> Either String t
	56	fromAtom (L _) = Left "Expected atom; found list"
	57	fromAtom (A a) = return a
	58
	59	-- \| RichSExpr a -> Either String two-element list (NOT a dotted pair) using the
	60	-- provided function.
	61	asPair :: ((RichSExpr t, RichSExpr t) -> Either String a)
	62	-> RichSExpr t -> Either String a
50	63	asPair f (L [l, r]) = f (l, r)
51		asPair _ sx = ~~fail~~ ("Expected two-element list")
	64	asPair _ sx = Left ("Expected two-element list")
52	65
53		asList :: ([S t] -> Either String a) -> S t -> Either String a
	66	-- \| Parse an arbitrary-length list using the provided function.
	67	asList :: ([RichSExpr t] -> Either String a)
	68	-> RichSExpr t -> Either String a
54	69	asList f (L ls) = f ls
55		asList _ sx = ~~fail~~ ("Expected list")
	70	asList _ sx = Left ("Expected list")
56	71
57		asSymbol :: (t -> Either String a) -> S t -> Either String a
58		asSymbol f (A s) = f s
59		asSymbol _ sx = fail ("Expected symbol")
	72	-- \| Match a given literal atom, failing otherwise.
	73	isAtom :: Eq t => t -> RichSExpr t -> Either String ()
	74	isAtom s (A s')
	75	\| s == s' = return ()
	76	\| otherwise = Left ".."
	77	isAtom _ _ = Left ".."
60	78
61		asAssoc :: ([(S t, S t)] -> Either String a) -> S t -> Either String a
	79	-- \| Parse an atom using the provided function.
	80	asAtom :: (t -> Either String a) -> RichSExpr t -> Either String a
	81	asAtom f (A s) = f s
	82	asAtom _ sx = Left ("Expected atom; got list")
	83
	84	-- \| Parse an assoc-list using the provided function.
	85	asAssoc :: Show t => ([(RichSExpr t, RichSExpr t)] -> Either String a)
	86	-> RichSExpr t -> Either String a
62	87	asAssoc f (L ss) = gatherPairs ss >>= f
63	88	where gatherPairs (L [a, b] : ss) = (:) <$> pure (a, b) <*> gatherPairs ss
64	89	gatherPairs [] = pure []
65		gatherPairs _ = fail "..."
66		asAssoc _ sx = fail ("Expected assoc list")
	90	gatherPairs _ = Left "..."
	91	asAssoc _ sx = Left ("Expected assoc list; got " ++ show sx)
	92
	93	car :: (RichSExpr t -> Either String t') -> [RichSExpr t] -> Either String t'
	94	car f (x:_) = f x
	95	car _ [] = Left "car: Taking car of zero-element list"
	96
	97	cdr :: ([RichSExpr t] -> Either String t') -> [RichSExpr t] -> Either String t'
	98	cdr f (_:xs) = f xs
	99	cdr _ [] = Left "cdr: Taking cdr of zero-element list"

+20

-12

Data/SCargot/Repr/WellFormed.hs less more

43	43	type Parse t a = R.WellFormedSExpr t -> Either String a
44	44
45	45	-- \| Utility function for parsing a pair of things.
46		fromPair :: ~~Parse t a -> Parse t b -> Parse t (a, b~~)
	46	fromPair :: (WellFormedSExpr t -> Either String a)
	47	-> (WellFormedSExpr t -> Either String b)
	48	-> WellFormedSExpr t -> Either String (a, b)
47	49	fromPair pl pr (L [l, r]) = (,) <$> pl l <*> pr r
48	50	fromPair _ _ sx = Left ("Expected two-element list")
49	51
50	52	-- \| Utility function for parsing a list of things.
51		fromList :: ~~Parse t a -> Parse t [a]~~
	53	fromList :: (WellFormedSExpr t -> Either String a)
	54	-> WellFormedSExpr t -> Either String [a]
52	55	fromList p (L ss) = mapM p ss
53	56	fromList _ sx = Left ("Expected list")
54	57
55		fromAtom :: ~~Parse t~~ t
	58	fromAtom :: WellFormedSExpr t -> Either String t
56	59	fromAtom (L _) = Left "Expected atom; found list"
57	60	fromAtom (A a) = return a
58	61
59		asPair :: ((~~S t, S t) -> Either String a) -> S t -> Either String a~~
	62	asPair :: ((WellFormedSExpr t, WellFormedSExpr t) -> Either String a)
	63	-> WellFormedSExpr t -> Either String a
60	64	asPair f (L [l, r]) = f (l, r)
61	65	asPair _ sx = Left ("Expected two-element list")
62	66
63		asList :: ([~~S t] -> Either String a) -> S t -> Either String a~~
	67	asList :: ([WellFormedSExpr t] -> Either String a)
	68	-> WellFormedSExpr t -> Either String a
64	69	asList f (L ls) = f ls
65	70	asList _ sx = Left ("Expected list")
66	71
67		isAtom :: Eq t => t -> S t -> Either String ()
	72	isAtom :: Eq t => t -> WellFormedSExpr t -> Either String ()
68	73	isAtom s (A s')
69	74	\| s == s' = return ()
70	75	\| otherwise = Left ".."
71	76	isAtom _ _ = Left ".."
72	77
73		asAtom :: ~~Show t => (t -> Either String a) -> S~~ t -> Either String a
	78	asAtom :: (t -> Either String a) -> WellFormedSExpr t -> Either String a
74	79	asAtom f (A s) = f s
75		asAtom _ sx = Left ("Expected atom; got~~" ++ show sx~~)
	80	asAtom _ sx = Left ("Expected atom; got list")
76	81
77		asAssoc :: ~~Show t => ([(S t, S t)] -> Either String a) -> S t -> Either String a~~
	82	asAssoc :: ([(WellFormedSExpr t, WellFormedSExpr t)] -> Either String a)
	83	-> WellFormedSExpr t -> Either String a
78	84	asAssoc f (L ss) = gatherPairs ss >>= f
79	85	where gatherPairs (L [a, b] : ss) = (:) <$> pure (a, b) <*> gatherPairs ss
80	86	gatherPairs [] = pure []
81	87	gatherPairs _ = Left "..."
82		asAssoc _ sx = Left ("Expected assoc list~~; got " ++ show sx~~)
	88	asAssoc _ sx = Left ("Expected assoc list")
83	89
84		car :: (~~S t -> Either String t') -> [S t] -> Either String t'~~
	90	car :: (WellFormedSExpr t -> Either String t')
	91	-> [WellFormedSExpr t] -> Either String t'
85	92	car f (x:_) = f x
86	93	car _ [] = Left "car: Taking car of zero-element list"
87	94
88		cdr :: ([~~S t] -> Either String t') -> [S t] -> Either String t'~~
	95	cdr :: ([WellFormedSExpr t] -> Either String t')
	96	-> [WellFormedSExpr t] -> Either String t'
89	97	cdr f (_:xs) = f xs
90	98	cdr _ [] = Left "cdr: Taking cdr of zero-element list"