gdritter repos s-cargot / 350aa7d
Switch from manual implementations to automatically derived implementations of Foldable/Traversable, and add Data and Typeable instances Getty Ritter 9 years ago
1 changed file(s) with 8 addition(s) and 32 deletion(s). Collapse all Expand all
+8
-32
Data/SCargot/Repr.hs less more
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE DeriveFoldable #-}
13 {-# LANGUAGE DeriveFunctor #-}
4 {-# LANGUAGE DeriveTraversable #-}
25 {-# LANGUAGE TypeFamilies #-}
36
47 module Data.SCargot.Repr
1417 , fromWellFormed
1518 ) where
1619
20 import Data.Data (Data)
1721 import Data.Foldable (Foldable(..))
1822 import Data.Monoid (Monoid(..), (<>))
1923 import Data.Traversable (Traversable(..))
24 import Data.Typeable (Typeable)
2025 import GHC.Exts (IsList(..), IsString(..))
2126
2227 -- | All S-Expressions can be understood as a sequence
2732 = SCons (SExpr atom) (SExpr atom)
2833 | SAtom atom
2934 | SNil
30 deriving (Eq, Show, Read, Functor, Data)
35 deriving (Eq, Show, Read, Functor, Data, Typeable, Foldable, Traversable)
3136
3237 instance IsString atom => IsString (SExpr atom) where
3338 fromString = SAtom . fromString
3944 where go (SCons x xs) = x : go xs
4045 go SNil = []
4146 go (SAtom {}) = error "Unable to turn atom into list"
42
43 instance Foldable SExpr where
44 foldMap _ SNil = mempty
45 foldMap f (SAtom a) = f a
46 foldMap f (SCons x y) = foldMap f x <> foldMap f y
47
48 instance Traversable SExpr where
49 traverse f SNil = pure SNil
50 traverse f (SAtom a) = SAtom <$> f a
51 traverse f (SCons x y) = SCons <$> traverse f x <*> traverse f y
5247
5348 -- | Sometimes the cons-based interface is too low
5449 -- level, and we'd rather have the lists themselves
6560 = RSList [RichSExpr atom]
6661 | RSDotted [RichSExpr atom] atom
6762 | RSAtom atom
68 deriving (Eq, Show, Read, Functor)
63 deriving (Eq, Show, Read, Functor, Data, Typeable, Foldable, Traversable)
6964
7065 instance IsString atom => IsString (RichSExpr atom) where
7166 fromString = RSAtom . fromString
9792 fromRich (RSList xs) = foldr SCons SNil (map fromRich xs)
9893 fromRich (RSDotted xs x) = foldr SCons (SAtom x) (map fromRich xs)
9994
100 instance Foldable RichSExpr where
101 foldMap f (RSAtom a) = f a
102 foldMap f (RSList xs) = mconcat $ map (foldMap f) xs
103 foldMap f (RSDotted xs y) = mconcat (map (foldMap f) xs) <> f y
104
105 instance Traversable RichSExpr where
106 traverse f (RSAtom a) = RSAtom <$> f a
107 traverse f (RSList xs) = RSList <$> sequenceA (map (traverse f) xs)
108 traverse f (RSDotted xs y) = RSDotted <$> sequenceA (map (traverse f) xs)
109 <*> f y
110
11195 -- | A well-formed s-expression is one which does not
11296 -- contain any dotted lists. This means that not
11397 -- every value of @SExpr a@ can be converted to a
116100 data WellFormedSExpr atom
117101 = WFSList [WellFormedSExpr atom]
118102 | WFSAtom atom
119 deriving (Eq, Show, Read, Functor)
103 deriving (Eq, Show, Read, Functor, Data, Typeable, Foldable, Traversable)
120104
121105 instance IsList (WellFormedSExpr atom) where
122106 type Item (WellFormedSExpr atom) = WellFormedSExpr atom
126110
127111 instance IsString atom => IsString (WellFormedSExpr atom) where
128112 fromString = WFSAtom . fromString
129
130 instance Foldable WellFormedSExpr where
131 foldMap f (WFSAtom a) = f a
132 foldMap f (WFSList xs) = mconcat $ map (foldMap f) xs
133
134 instance Traversable WellFormedSExpr where
135 traverse f (WFSAtom a) = WFSAtom <$> f a
136 traverse f (WFSList xs) = WFSList <$> sequenceA (map (traverse f) xs)
137113
138114 -- | This will be @Nothing@ if the argument contains an
139115 -- improper list. It should hold that