Commit 2938e9b9afce4e81424e977c1301765a6d0e1f0f - s-cargot

Added lenses for Basic and Rich repr; how to add them in a non-partial way to WF is an open question Getty Ritter 9 years ago

2 changed file(s) with 45 addition(s) and 0 deletion(s). Collapse all Expand all

+15

-0

Data/SCargot/Repr/Basic.hs less more

7	7	, pattern (:::)
8	8	, pattern A
9	9	, pattern Nil
	10	-- * Lenses
	11	, _car
	12	, _cdr
10	13	-- * Useful processing functions
11	14	, fromPair
12	15	, fromList

20	23
21	24	import Control.Applicative ((<$>), (<*>), pure)
22	25	import Data.SCargot.Repr as R
	26
	27	-- \| A traversal with access to the first element of a pair.
	28	_car :: Applicative f => (SExpr a -> f (SExpr a)) -> SExpr a -> f (SExpr a)
	29	_car f (x ::: xs) = (:::) <$> f x <*> pure xs
	30	_car _ (A a) = pure (A a)
	31	_car _ Nil = pure Nil
	32
	33	-- \| A traversal with access to the second element of a pair.
	34	_cdr :: Applicative f => (SExpr a -> f (SExpr a)) -> SExpr a -> f (SExpr a)
	35	_cdr f (x ::: xs) = (:::) <$> pure x <*> f xs
	36	_cdr _ (A a) = pure (A a)
	37	_cdr _ Nil = pure Nil
23	38
24	39	infixr 5 :::
25	40

+30

-0

Data/SCargot/Repr/Rich.hs less more

11	11	, pattern L
12	12	, pattern DL
13	13	, pattern Nil
	14	-- * Lenses
	15	, _car
	16	, _cdr
14	17	-- * Useful processing functions
15	18	, fromPair
16	19	, fromList

24	27
25	28	import Control.Applicative ((<$>), (<*>), pure)
26	29	import Data.SCargot.Repr as R
	30
	31	-- \| A traversal with access to the first element of a pair.
	32	_car :: Applicative f => (RichSExpr a -> f (RichSExpr a)) -> RichSExpr a -> f (RichSExpr a)
	33	_car f (L (x:xs)) = (\ x -> L (x:xs)) `fmap` f x
	34	_car f (DL (x:xs) a) = (\ x -> DL (x:xs) a) `fmap` f x
	35	_car _ (A a) = pure (A a)
	36	_car _ Nil = pure Nil
	37
	38	-- \| A traversal with access to the second element of a pair.
	39	_cdr :: Applicative f => (RichSExpr a -> f (RichSExpr a)) -> RichSExpr a -> f (RichSExpr a)
	40	_cdr f (L (x:xs)) =
	41	let go Nil = L [x]
	42	go (A a) = DL [x] a
	43	go (L xs') = L (x:xs')
	44	in go `fmap` f (L xs)
	45	_cdr f (DL [x] a) =
	46	let go Nil = L [x]
	47	go (A a') = DL [x] a'
	48	go (L xs) = L (x:xs)
	49	in go `fmap` f (A a)
	50	_cdr f (DL (x:xs) a) =
	51	let go Nil = L [x]
	52	go (A a') = DL [x] a'
	53	go (L xs) = L (x:xs)
	54	in go `fmap` f (DL xs a)
	55	_cdr _ (A a) = pure (A a)
	56	_cdr _ Nil = pure Nil
27	57
28	58	-- \| A shorter infix alias to grab the head
29	59	-- and tail of an `RSList`.