Data.hs

{-# LANGUAGE DeriveDataTypeable #-}

module Data.SExp.Data 
  ( Atom(..), AntiAtom(..)
  , OpenLink(..) , OpenSExp(..)
  , SExp(..), SExpLink(..)
  , DualSExp(..), DualSExpLink(..)
  , sexpSymbolValue, sexpToList, sexpLinkToList, listToSExp, listToSExpLink
  ) where

import Data.Generics

-- Atoms and Anti-Atoms

data Atom =
    StringAtom String
  | BooleanAtom Bool
  | IntegerAtom Integer
  | FloatingAtom Double
  | SymbolAtom String
  deriving (Eq, Ord, Show, Typeable, Data)

data AntiAtom =
  -- | Created with QuasiQuotes of form @[sexp| \@:name |]@. Will be converted
  -- to expression or pattern of type 'SExp'.  @name@ will be bound with type
  -- 'SExp'.
    ValueAntiAtom String
  -- | Created with QuasiQuotes of form @[sexp| \@atom:name |]@. Will be
  -- converted to expression or pattern of type 'SExp'.  @name@ will be bound
  -- with type 'Atom'.
  | AtomAntiAtom String
  -- | Created with QuasiQuotes of form @[sexp| \@list:name |]@. Will be
  -- converted to expression or pattern of type 'SExp'.  @name@ will be bound
  -- with type '[SExp]'.
  | ListAntiAtom String
  -- | Created with QuasiQuotes of form @[sexp| \@str:name |]@. Will be
  -- converted to expression or pattern of type 'SExp'.  @name@ will be bound
  -- with type 'String'.
  | StringAntiAtom String
  -- | Created with QuasiQuotes of form @[sexp| \@bool:name |]@.  Will be
  -- converted to expression or pattern of type 'SExp'.  @name@ will be bound
  -- with type 'Bool'.
  | BooleanAntiAtom String
  -- | Created with QuasiQuotes of form @[sexp| \@int:name |]@.  Will be
  -- converted to expression or pattern of type 'SExp'.  @name@ will be bound
  -- with type 'Integer'.
  | IntegerAntiAtom String
  -- | Created with QuasiQuotes of form @[sexp| \@float:name |]@.  Will be
  -- converted to expression or pattern of type 'SExp'.  @name@ will be bound
  -- with type 'Double'.
  | FloatingAntiAtom String
  -- | Created with QuasiQuotes of form @[sexp| \@sym:name |]@.  Will be
  -- converted to expression or pattern of type 'SExp'.  @name@ will be bound
  -- with type 'String'.
  | SymbolAntiAtom String
  deriving (Eq, Ord, Show, Typeable, Data)

-- Generic Link Structure

data OpenLink sd sl =
    NullLink
  | ConsLink sd sl
  deriving (Eq, Ord, Show, Typeable, Data)

-- Standard S-Expressions

data OpenSExp sl =
    AtomSExp Atom
  | LinkSExp sl
  deriving (Eq, Ord, Show, Typeable, Data)

newtype SExp = SExp { unSExp :: OpenSExp SExpLink } 
  deriving (Eq, Ord, Show, Typeable, Data)
newtype SExpLink = SExpLink { unSExpLink :: OpenLink SExp SExpLink } 
  deriving (Eq, Ord, Show, Typeable, Data)

-- Anti S-Expressions

data DualSExp =
    PositiveDualSExp (OpenSExp DualSExpLink)
  | AntiAtomDualSExp AntiAtom
  deriving (Eq, Ord, Show, Typeable, Data)

data DualSExpLink =
    PositiveDualSExpLink (OpenLink DualSExp DualSExpLink)
  | AntiConsValueDualSExpLink String
  | AntiConsListDualSExpLink String
  deriving (Eq, Ord, Show, Typeable, Data)

sexpSymbolValue :: SExp -> Maybe String
sexpSymbolValue (SExp (AtomSExp (SymbolAtom s))) = Just s
sexpSymbolValue _ = Nothing

sexpToList :: SExp -> Maybe [SExp]
sexpToList (SExp (LinkSExp l)) = Just $ sexpLinkToList l
sexpToList _ = Nothing

sexpLinkToList :: SExpLink -> [SExp]
sexpLinkToList (SExpLink NullLink) = []
sexpLinkToList (SExpLink (ConsLink h t)) = h:sexpLinkToList t

listToSExp :: [SExp] -> SExp
listToSExp ss = SExp . LinkSExp $ listToSExpLink ss

listToSExpLink :: [SExp] -> SExpLink
listToSExpLink [] = SExpLink NullLink
listToSExpLink (s:ss) = SExpLink . ConsLink s $ listToSExpLink ss