| 14 | 14 |
, fromWellFormed
|
| 15 | 15 |
) where
|
| 16 | 16 |
|
| 17 | |
--import Data.String (IsString(..))
|
| 17 |
import Data.Foldable (Foldable(..))
|
| 18 |
import Data.Monoid (Monoid(..), (<>))
|
| 19 |
import Data.Traversable (Traversable(..))
|
| 18 | 20 |
import GHC.Exts (IsList(..), IsString(..))
|
| 19 | 21 |
|
| 20 | 22 |
-- | All S-Expressions can be understood as a sequence
|
|
| 25 | 27 |
= SCons (SExpr atom) (SExpr atom)
|
| 26 | 28 |
| SAtom atom
|
| 27 | 29 |
| SNil
|
| 28 | |
deriving (Eq, Show, Read, Functor |
| 30 |
deriving (Eq, Show, Read, Functor, Data)
|
| 29 | 31 |
|
| 30 | 32 |
instance IsString atom => IsString (SExpr atom) where
|
| 31 | 33 |
fromString = SAtom . fromString
|
|
| 33 | 35 |
instance IsList (SExpr atom) where
|
| 34 | 36 |
type Item (SExpr atom) = SExpr atom
|
| 35 | 37 |
fromList = foldr SCons SNil
|
| 36 | |
toList = undefined
|
| 38 |
toList = go
|
| 39 |
where go (SCons x xs) = x : go xs
|
| 40 |
go SNil = []
|
| 41 |
go (SAtom {}) = error "Unable to turn atom into list"
|
| 37 | 42 |
|
| 38 | |
-- | sometimes, the cons-based interface is too low
|
| 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
|
| 52 |
|
| 53 |
-- | Sometimes the cons-based interface is too low
|
| 39 | 54 |
-- level, and we'd rather have the lists themselves
|
| 40 | 55 |
-- exposed. In this case, we have 'RSList' to
|
| 41 | 56 |
-- represent a well-formed cons list, and 'RSDotted'
|
|
| 82 | 97 |
fromRich (RSList xs) = foldr SCons SNil (map fromRich xs)
|
| 83 | 98 |
fromRich (RSDotted xs x) = foldr SCons (SAtom x) (map fromRich xs)
|
| 84 | 99 |
|
| 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 |
|
| 85 | 111 |
-- | A well-formed s-expression is one which does not
|
| 86 | 112 |
-- contain any dotted lists. This means that not
|
| 87 | 113 |
-- every value of @SExpr a@ can be converted to a
|
|
| 100 | 126 |
|
| 101 | 127 |
instance IsString atom => IsString (WellFormedSExpr atom) where
|
| 102 | 128 |
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)
|
| 103 | 137 |
|
| 104 | 138 |
-- | This will be @Nothing@ if the argument contains an
|
| 105 | 139 |
-- improper list. It should hold that
|