module Codec.Sexpr (
Sexpr,
isAtom,
isList,
atom,
list,
unAtom,
unList,
hintedAtom,
hint,
defaultHint,
isTokenChar,isInitialTokenChar,isQuoteableChar
) where
import Control.Applicative
import Data.Char
import qualified Data.Foldable as F
import Data.Traversable
data Sexpr s = Atom s
| HintedAtom String s
| List [Sexpr s]
instance Eq s => Eq (Sexpr s) where
(List a) == (List b) = and $ zipWith (==) a b
a == b = unAtom a == unAtom b && hint a == hint b
instance Functor Sexpr where
fmap f (Atom s) = Atom (f s)
fmap f (HintedAtom h s) = HintedAtom h (f s)
fmap f (List ss) = List $ map (fmap f) ss
instance F.Foldable Sexpr where
foldMap f (Atom s) = f s
foldMap f (HintedAtom h s) = f s
foldMap f (List ss) = F.foldMap (F.foldMap f) ss
instance Traversable Sexpr where
traverse f (Atom s) = Atom <$> f s
traverse f (HintedAtom h s) = HintedAtom h <$> f s
traverse f (List ss) = List <$> traverse (traverse f) ss
fold :: (Sexpr t -> Sexpr t) -> Sexpr t -> Sexpr t
fold f z@(Atom s) = f z
fold f z@(HintedAtom h s) = f z
fold f (List ss) = f . List $ map (fold f) ss
defaultHint :: String
defaultHint = "text/plain; charset=iso-8859-1"
atom :: a -> Sexpr a
atom s = Atom s
list :: [Sexpr a] -> Sexpr a
list xs = List xs
hintedAtom :: String -> a -> Sexpr a
hintedAtom h s | h == defaultHint = Atom s
hintedAtom h s = HintedAtom h s
isList :: Sexpr a -> Bool
isList (List _) = True
isList _ = False
isAtom :: Sexpr a -> Bool
isAtom (List _) = False
isAtom _ = True
hint :: Sexpr a -> Maybe String
hint (Atom s) = Just defaultHint
hint (HintedAtom h s) = Just h
hint _ = Nothing
unAtom :: Sexpr s -> s
unAtom (Atom s) = s
unAtom (HintedAtom h s) = s
unList :: Sexpr s -> [Sexpr s]
unList (List xs) = xs
isInitialTokenChar :: Char -> Bool
isInitialTokenChar x = isAlpha x || x `elem` "-./_:*+="
isTokenChar :: Char -> Bool
isTokenChar x = isAlphaNum x || x `elem` "-./_:*+="
isQuoteableChar :: Char -> Bool
isQuoteableChar x = isTokenChar x || isSpace x