S-expression de/serializer using typeclasses

Sexp.hs

module Sexp (Sexp, parseSexp) where

import Text.Parsec
import Text.Parsec.Char
import Data.Char
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Map (Map)
import qualified Data.Map as Map

data Sexp = AtomSymbol Text
          | AtomString Text
          | AtomNumber Integer
          | Sexp [Sexp]

instance Show Sexp where
  show (AtomSymbol a) = show a
  show (AtomString a) = show a
  show (AtomNumber a) = show a
  show (Sexp a) = parenthesize . unwords $ show <$> a
    where parenthesize :: String -> String
          parenthesize a = '(':a++")"

class SexpSerializable a where
  serialize :: a -> Sexp
  deserialize :: Sexp -> Maybe a

instance SexpSerializable Text where
  serialize a = AtomString (Text.pack $ show a)
  deserialize (AtomString a) = Just a
  deserialize _ = Nothing

instance SexpSerializable Integer where
  serialize a = AtomNumber a
  deserialize (AtomNumber a) = Just a
  deserialize _ = Nothing

instance (SexpSerializable a, Eq a) => SexpSerializable [a] where
  serialize a = Sexp $ serialize <$> a
  deserialize (Sexp a) = if any (== Nothing) ln
                         then Nothing
                         else Just $ (\(Just a) -> a) <$> ln
    where ln = deserialize <$> a
  deserialize _ = Nothing

parseSexp :: String -> Either ParseError Sexp
parseSexp = parse sexpParser ""

sexpParser :: Parsec String () Sexp
sexpParser =
  skipWhitespace
  >> between (char '(') (char ')')
  (Sexp <$> sepBy (choice
  [
    AtomString . Text.pack <$> between quote quote (many $ noneOf "\"")
  , AtomNumber . (read :: String -> Integer) <$> many1 digit
  , AtomSymbol . Text.pack . fmap toLower <$> many1 letter
  , sexpParser
  ])
   skipWhitespace)
  where skipWhitespace = skipMany $ oneOf " \n\t\r"
        quote = char '"'