s-cargot-0.1.0.0: A flexible, extensible s-expression library.

Safe HaskellNone
LanguageHaskell2010

Data.SCargot.Repr.Basic

Contents

Synopsis

Basic SExpr representation

data SExpr atom Source

All S-Expressions can be understood as a sequence of cons cells (represented here by SCons), the empty list nil (represented by SNil) or an atom.

Constructors

SCons (SExpr atom) (SExpr atom) 
SAtom atom 
SNil 

Instances

Functor SExpr Source 
Foldable SExpr Source 
Traversable SExpr Source 
IsList (SExpr atom) Source 
Eq atom => Eq (SExpr atom) Source 
Data atom => Data (SExpr atom) Source 
Read atom => Read (SExpr atom) Source 
Show atom => Show (SExpr atom) Source 
IsString atom => IsString (SExpr atom) Source 
type Item (SExpr atom) = SExpr atom Source 

Constructing and Deconstructing

cons :: SExpr a -> SExpr a -> SExpr a Source

Combine the two s-expressions into a new one.

>>> cons (A "el") (L ["eph", A "ant"])
SCons (SAtom "el) (SCons (SAtom "eph") (SCons (SAtom "ant") SNil))

uncons :: SExpr a -> Maybe (SExpr a, SExpr a) Source

Produce the head and tail of the s-expression (if possible).

>>> uncons (A "el" ::: A "eph" ::: A "ant" ::: Nil)
Just (A "el",SCons (SAtom "eph") (SCons (SAtom "ant") SNil))

Shorthand Patterns

pattern (:::) :: SExpr t -> SExpr t -> SExpr t infixr 5 Source

A shorter infix alias for SCons

>>> A "pachy" ::: A "derm"
SCons (SAtom "pachy") (SAtom "derm")

pattern A :: t -> SExpr t Source

A shorter alias for SAtom

>>> A "elephant"
SAtom "elephant"

pattern L :: [SExpr t] -> SExpr t Source

An alias for matching a proper list.

>>> L [A "pachy", A "derm"]
SCons (SAtom "pachy") (SCons (SAtom "derm") SNil)

pattern DL :: [SExpr a] -> a -> SExpr a Source

An alias for matching a dotted list.

>>> DL [A "pachy"] A "derm"
SCons (SAtom "pachy") (SAtom "derm")

pattern Nil :: SExpr t Source

A (slightly) shorter alias for SNil

>>> Nil
SNil

Lenses

_car :: Applicative f => (SExpr a -> f (SExpr a)) -> SExpr a -> f (SExpr a) Source

A traversal with access to the first element of a pair.

>>> import Lens.Family
>>> set _car (A "elephant") (A "one" ::: A "two" ::: A "three" ::: Nil)
A "elelphant" ::: A "two" ::: A "three" ::: Nil
>>> set _car (A "two" ::: A "three" ::: Nil) (A "one" ::: A "elephant")
(A "two" ::: A "three" ::: Nil) ::: A "elephant"

_cdr :: Applicative f => (SExpr a -> f (SExpr a)) -> SExpr a -> f (SExpr a) Source

A traversal with access to the second element of a pair.

>>> import Lens.Family
>>> set _cdr (A "elephant") (A "one" ::: A "two" ::: A "three" ::: Nil)
A "one" ::: A "elephant"
>>> set _cdr (A "two" ::: A "three" ::: Nil) (A "one" ::: A "elephant")
A "one" ::: A "two" ::: A "three" ::: Nil

Useful processing functions

fromPair :: (SExpr t -> Either String a) -> (SExpr t -> Either String b) -> SExpr t -> Either String (a, b) Source

Utility function for parsing a pair of things.

>>> fromPair (isAtom "pachy") (asAtom return) (A "pachy" ::: A "derm" ::: Nil)
Right ((), "derm")
>>> fromPair (isAtom "pachy") fromAtom (A "pachy" ::: Nil)
Left "Expected two-element list"

fromList :: (SExpr t -> Either String a) -> SExpr t -> Either String [a] Source

Utility function for parsing a list of things.

fromAtom :: SExpr t -> Either String t Source

Utility function for parsing a single atom

asPair :: ((SExpr t, SExpr t) -> Either String a) -> SExpr t -> Either String a Source

Parse a two-element list (NOT a dotted pair) using the provided function.

>>> let go (A l) (A r) = return (l ++ r); go _ _ = Left "expected atoms"
>>> asPair go (A "pachy" ::: A "derm" ::: Nil)
Right "pachyderm"
>>> asPair go (A "elephant" ::: Nil)
Left "asPair: expected two-element list; found list of length 1"

asList :: ([SExpr t] -> Either String a) -> SExpr t -> Either String a Source

Parse an arbitrary-length list using the provided function.

>>> let go xs = concat <$> mapM fromAtom xs
>>> asList go (A "el" ::: A "eph" ::: A "ant" ::: Nil)
Right "elephant"
>>> asList go (A "el" ::: A "eph" ::: A "ant")
Left "asList: expected list; found dotted list of length 3"

isAtom :: Eq t => t -> SExpr t -> Either String () Source

Match a given literal atom, failing otherwise.

>>> isAtom "elephant" (A "elephant")
Right ()
>>> isAtom "elephant" (A "elephant" ::: Nil)
Left "isAtom: expected atom; found list"

asAtom :: (t -> Either String a) -> SExpr t -> Either String a Source

Parse an atom using the provided function.

>>> import Data.Char (toUpper)
>>> asAtom (return . map toUpper) (A "elephant")
Right "ELEPHANT"
>>> asAtom (return . map toUpper) Nil
Left "asAtom: expected atom; found empty list"

asAssoc :: ([(SExpr t, SExpr t)] -> Either String a) -> SExpr t -> Either String a Source

Parse an assoc-list using the provided function.

>>> let def (x, y) = do { a <- fromAtom x; b <- fromAtom y; return (a ++ ": " ++ b) }
>>> let defList xs = do { defs <- mapM def xs; return (unlines defs) }
>>> asAssoc defList ((A "legs" ::: A "four" ::: Nil) ::: (A "trunk" ::: A "one" ::: Nil) ::: Nil)
Right "legs: four\ntrunk: one\n"
>>> asAssoc defList ((A "legs" ::: A "four" ::: Nil) ::: (A "elephant") ::: Nil)
Left "asAssoc: expected pair; found list of length 1"