Commit b79d70eee5f183a567c5e49a1f78b27bc434f48b - s-cargot

Added richer bidirectional pattern synonyms and changed the semantics of ::: to be more consistent Getty Ritter 8 years ago

3 changed file(s) with 129 addition(s) and 4 deletion(s). Collapse all Expand all

+62

-0

Data/SCargot/Repr/Basic.hs less more

1	1	{-# LANGUAGE PatternSynonyms #-}
	2	{-# LANGUAGE ViewPatterns #-}
2	3
3	4	module Data.SCargot.Repr.Basic
4	5	( -- * Basic 'SExpr' representation
5	6	R.SExpr(..)
	7	-- * Constructing and Deconstructing
	8	, cons
	9	, uncons
6	10	-- * Shorthand Patterns
7	11	, pattern (:::)
8	12	, pattern A
	13	, pattern L
	14	, pattern DL
9	15	, pattern Nil
10	16	-- * Lenses
11	17	, _car

48	54	_cdr _ (A a) = pure (A a)
49	55	_cdr _ Nil = pure Nil
50	56
	57	-- \| Produce the head and tail of the s-expression (if possible).
	58	--
	59	-- >>> uncons (A "el" ::: A "eph" ::: A "ant" ::: Nil)
	60	-- Just (A "el",SCons (SAtom "eph") (SCons (SAtom "ant") SNil))
	61	uncons :: SExpr a -> Maybe (SExpr a, SExpr a)
	62	uncons (SCons x xs) = Just (x, xs)
	63	uncons _ = Nothing
	64
	65	-- \| Combine the two s-expressions into a new one.
	66	--
	67	-- >>> cons (A "el") (L ["eph", A "ant"])
	68	-- SCons (SAtom "el) (SCons (SAtom "eph") (SCons (SAtom "ant") SNil))
	69	cons :: SExpr a -> SExpr a -> SExpr a
	70	cons = SCons
	71
	72	mkList :: [SExpr a] -> SExpr a
	73	mkList [] = SNil
	74	mkList (x:xs) = SCons x (mkList xs)
	75
	76	mkDList :: [SExpr a] -> a -> SExpr a
	77	mkDList [] a = SAtom a
	78	mkDList (x:xs) a = SCons x (mkDList xs a)
	79
	80	gatherDList :: SExpr a -> Maybe ([SExpr a], a)
	81	gatherDList SNil = Nothing
	82	gatherDList SAtom {} = Nothing
	83	gatherDList sx = go sx
	84	where go SNil = Nothing
	85	go (SAtom a) = return ([], a)
	86	go (SCons x xs) = do
	87	(ys, a) <- go xs
	88	return (x:ys, a)
	89
51	90	infixr 5 :::
52	91
53	92	-- \| A shorter infix alias for `SCons`
	93	--
	94	-- >>> A "pachy" ::: A "derm"
	95	-- SCons (SAtom "pachy") (SAtom "derm")
54	96	pattern x ::: xs = SCons x xs
55	97
56	98	-- \| A shorter alias for `SAtom`
	99	--
	100	-- >>> A "elephant"
	101	-- SAtom "elephant"
57	102	pattern A x = SAtom x
58	103
59	104	-- \| A (slightly) shorter alias for `SNil`
	105	--
	106	-- >>> Nil
	107	-- SNil
60	108	pattern Nil = SNil
	109
	110	-- \| An alias for matching a proper list.
	111	--
	112	-- >>> L [A "pachy", A "derm"]
	113	-- SCons (SAtom "pachy") (SCons (SAtom "derm") SNil)
	114	pattern L xs <- (gatherList -> Right xs)
	115	where L xs = mkList xs
	116
	117	-- \| An alias for matching a dotted list.
	118	--
	119	-- >>> DL [A "pachy"] A "derm"
	120	-- SCons (SAtom "pachy") (SAtom "derm")
	121	pattern DL xs x <- (gatherDList -> Just (xs, x))
	122	where DL xs x = mkDList xs x
61	123
62	124	getShape :: SExpr a -> String
63	125	getShape Nil = "empty list"

+39

-1

Data/SCargot/Repr/Rich.hs less more

1	1	{-# LANGUAGE PatternSynonyms #-}
	2	{-# LANGUAGE ViewPatterns #-}
2	3
3	4	module Data.SCargot.Repr.Rich
4	5	( -- * 'RichSExpr' representation
5	6	R.RichSExpr(..)
6	7	, R.toRich
7	8	, R.fromRich
	9	-- * Constructing and Deconstructing
	10	, cons
	11	, uncons
8	12	-- * Useful pattern synonyms
9	13	, pattern (:::)
10	14	, pattern A

71	75	_cdr _ (A a) = pure (A a)
72	76	_cdr _ Nil = pure Nil
73	77
	78	-- \| Produce the head and tail of the s-expression (if possible).
	79	--
	80	-- >>> uncons (L [A "el", A "eph", A "ant"])
	81	-- Just (A "el",L [A "eph",A "ant"])
	82	uncons :: RichSExpr a -> Maybe (RichSExpr a, RichSExpr a)
	83	uncons R.RSAtom {} = Nothing
	84	uncons (R.RSList (x:xs)) = Just (x, R.RSList xs)
	85	uncons (R.RSDotted (x:xs) a) = Just (x, R.RSDotted xs a)
	86
	87	-- \| Combine the two s-expressions into a new one.
	88	--
	89	-- >>> cons (A "el") (L [A "eph", A "ant"])
	90	-- L [A "el",A "eph",A "ant"]
	91	cons :: RichSExpr a -> RichSExpr a -> RichSExpr a
	92	cons x (R.RSList xs) = R.RSList (x:xs)
	93	cons x (R.RSDotted xs a) = R.RSDotted (x:xs) a
	94	cons x (R.RSAtom a) = R.RSDotted [x] a
	95
74	96	-- \| A shorter infix alias to grab the head
75	97	-- and tail of an `RSList`.
76		pattern x ::: xs = R.RSList (x : xs)
	98	--
	99	-- >>> A "one" ::: L [A "two", A "three"]
	100	-- RSList [RSAtom "one",RSAtom "two",RSAtom "three"]
	101	pattern x ::: xs <- (uncons -> Just (x, xs))
	102	where x ::: xs = cons x xs
77	103
78	104	-- \| A shorter alias for `RSAtom`
	105	--
	106	-- >>> A "elephant"
	107	-- RSAtom "elephant"
79	108	pattern A a = R.RSAtom a
80	109
81	110	-- \| A shorter alias for `RSList`
	111	--
	112	-- >>> L [A "pachy", A "derm"]
	113	-- RSList [RSAtom "pachy",RSAtom "derm"]
82	114	pattern L xs = R.RSList xs
83	115
84	116	-- \| A shorter alias for `RSDotted`
	117	--
	118	-- >>> DL [A "pachy"] "derm"
	119	-- RSDotted [RSAtom "pachy"] "derm"
85	120	pattern DL xs x = R.RSDotted xs x
86	121
87	122	-- \| A shorter alias for `RSList` @[]@
	123	--
	124	-- >>> Nil
	125	-- RSList []
88	126	pattern Nil = R.RSList []
89	127
90	128	-- \| Utility function for parsing a pair of things: this parses a two-element list,

+28

-3

Data/SCargot/Repr/WellFormed.hs less more

1	1	{-# LANGUAGE PatternSynonyms #-}
	2	{-# LANGUAGE ViewPatterns #-}
2	3
3	4	module Data.SCargot.Repr.WellFormed
4	5	( -- * 'WellFormedSExpr' representation
5	6	R.WellFormedSExpr(..)
6	7	, R.toWellFormed
7	8	, R.fromWellFormed
	9	-- * Constructing and Deconstructing
	10	, cons
	11	, uncons
8	12	-- * Useful pattern synonyms
9	13	, pattern (:::)
10	14	, pattern L

26	30	import Control.Applicative ((<$>), (<*>), pure)
27	31	import Data.SCargot.Repr as R
28	32
29		-- \| A shorter infix alias to grab the head
30		-- and tail of a `WFSList`
31		~~pattern x ::: xs = R.WFSList (x : xs~~)
	33	uncons :: WellFormedSExpr a -> Maybe (WellFormedSExpr a, WellFormedSExpr a)
	34	uncons R.WFSAtom {} = Nothing
	35	uncons (R.WFSList (x:xs)) = Just (x, R.WFSList xs)
	36
	37	cons :: WellFormedSExpr a -> WellFormedSExpr a -> Maybe (WellFormedSExpr a)
	38	cons _ (R.WFSAtom {}) = Nothing
	39	cons x (R.WFSList xs) = Just (R.WFSList (x:xs))
	40
	41	-- \| A shorter infix alias to grab the head and tail of a `WFSList`. This
	42	-- pattern is unidirectional, because it cannot be guaranteed that it
	43	-- is used to construct well-formed s-expressions; use the function "cons"
	44	-- instead.
	45	--
	46	-- >>> let sum (x ::: xs) = x + sum xs; sum Nil = 0
	47	pattern x ::: xs <- (uncons -> Just (x, xs))
32	48
33	49	-- \| A shorter alias for `WFSList`
	50	--
	51	-- >>> L [A "pachy", A "derm"]
	52	-- WFSList [WFSAtom "pachy",WFSAtom "derm"]
34	53	pattern L xs = R.WFSList xs
35	54
36	55	-- \| A shorter alias for `WFSAtom`
	56	--
	57	-- >>> A "elephant"
	58	-- WFSAtom "elephant"
37	59	pattern A a = R.WFSAtom a
38	60
39	61	-- \| A shorter alias for `WFSList` @[]@
	62	--
	63	-- >>> Nil
	64	-- WFSList []
40	65	pattern Nil = R.WFSList []
41	66
42	67	getShape :: WellFormedSExpr a -> String