s-cargot/Data/SExpression/Repr.hs

module Data.SExpression.Repr
       ( SExpr(..)
       , RichSExpr(..)
       , toRich
       , fromRich
       , WellFormedSExpr(..)
       , toWellFormed
       , fromWellFormed
       ) where

-- | 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@.
data SExpr atom
  = SCons (SExpr atom) (SExpr atom)
  | SAtom atom
  | SNil
    deriving (Eq, Show, Read)

-- | Sometimes, the cons-based interface is too low
--   level, and we'd rather have the lists themselves
--   exposed. In this case, we have @RSList@ to
--   represent a well-formed cons list, and @RSDotted@
--   to represent an improper list of the form
--   @(a b c . d)@.
data RichSExpr atom
  = RSList [RichSExpr atom]
  | RSDotted [RichSExpr atom] atom
  | RSAtom atom
    deriving (Eq, Show, Read)

toRich :: SExpr atom -> RichSExpr atom
toRich (SAtom a) = RSAtom a
toRich (SCons x xs) = go xs [toRich x]
  where go (SAtom a) rs    = RSDotted rs a
        go SNil rs         = RSList rs
        go (SCons x xs) rs = go xs (toRich x:rs)

fromRich :: RichSExpr atom -> SExpr atom
fromRich (RSAtom a) = SAtom a
fromRich (RSList xs) = foldr SCons SNil (map fromRich xs)
fromRich (RSDotted xs x) = foldr SCons (SAtom x) (map fromRich xs)

-- | A well-formed s-expression is one which does not
--   contain any dotted lists. This means that not
--   every value of @SExpr a@ can be converted to a
--   @WellFormedSExpr a@, although the opposite is
--   fine.
data WellFormedSExpr atom
  = WFSList [WellFormedSExpr atom]
  | WFSAtom atom
    deriving (Eq, Show, Read)

-- | This will be @Nothing@ is the argument contains an
--   improper list. It should hold that
toWellFormed :: SExpr atom -> Maybe (WellFormedSExpr atom)
toWellFormed (SAtom a) = Just (WFSAtom a)
toWellFormed (SCons x xs) = do
  x' <- toWellFormed x
  go xs [x']
  where go (SAtom a) rs = Nothing
        go SNil rs      = Just (WFSList rs)
        go (SCons x xs) rs = do
          x' <- toWellFormed x
          go xs (x':rs)

-- | Convert a WellFormedSExpr back into a SExpr.
fromWellFormed :: WellFormedSExpr atom -> SExpr atom
fromWellFormed (WFSAtom a)  = SAtom a
fromWellFormed (WFSList xs) =
  foldr SCons SNil (map fromWellFormed xs)