module Codec.Sexpr (Sexpr,
                    atom,
                    hintedAtom,
                    list,
                    isAtom,
                    isList,
                    hint,
                    defaultHint,
                    unAtom,
                    unList,
                    isTokenChar,isInitialTokenChar,isQuoteableChar
                   ) where

import Data.Char

data Sexpr = Atom String
           | HintedAtom String String
           | List [Sexpr] 

instance Eq Sexpr where
    (List a) == (List b) = and $ zipWith (==) a b
    a == b = unAtom a == unAtom b && hint a == hint b

defaultHint = "text/plain; charset=iso-8859-1"

atom s = Atom s
list xs = List xs
hintedAtom h s | h == defaultHint = Atom s
hintedAtom h s = HintedAtom h s

isList (List _) = True
isList _ = False

isAtom (List _) = False
isAtom _ = True

hint (Atom s) = Just defaultHint
hint (HintedAtom h s) = Just h
hint _ = Nothing

unAtom (Atom s) = s
unAtom (HintedAtom h s) = s

unList (List xs) = xs

isInitialTokenChar x = isAlpha x || x `elem` "-./_:*+="

isTokenChar x = isAlphaNum x || x `elem` "-./_:*+="

isQuoteableChar x = isTokenChar x || isSpace x