content: {-# LANGUAGE FlexibleContexts #-}
  module Data.ATerm where
  
  import           Control.Applicative
  import           Control.Monad.Except
  
  import           Data.Attoparsec.Text hiding (string,number)
  
  import           Data.Text (Text)
  import qualified Data.Text as T
  
  import qualified Data.List as L
  
  data ATerm
    = ATerm Text [ATerm]
    | List [ATerm]
    | String Text
    | Number Int
  
  instance Show ATerm where
    show t = case t of
      ATerm c ts -> T.unpack c ++ "(" ++ L.intercalate "," (show <$> ts) ++ ")"
      List ts -> show ts
      String s -> show s
      Number i -> show i
  
  parseATerm :: (MonadError String m) => Text -> m ATerm
  parseATerm t = case parse aterm t of
    Done _ r -> return r
    Fail _ _ err -> throwError err
    Partial {} -> throwError "Partial"
  
  aterm :: Parser ATerm
  aterm = constructor <|> constant <|> list <|> string <|> number
  
  constructor :: Parser ATerm
  constructor = do
    con <- many1 letter
    _ <- char '('
    ts <- aterm `sepBy` char ','
    _ <- char ')'
    return $ ATerm (T.pack con) ts
  
  constant :: Parser ATerm
  constant = do
    con <- many1 letter
    return $ ATerm (T.pack con) []
  
  list :: Parser ATerm
  list = do
    _ <- char '['
    ts <- aterm `sepBy` char ','
    _ <- char ']'
    return $ List ts
  
  string :: Parser ATerm
  string = String <$> (char '"' *> concatMany (normalString <|> quotedChar) <* char '"')
    where
      quotedChar :: Parser Text
      quotedChar = do
        e <- char '\\'
        c <- anyChar
        return $ T.pack [e,c]
  
      normalString :: Parser Text
      normalString = takeWhile1 (\c -> c /= '"' && c /= '\\')
  
  
  concatMany :: (Alternative f, Monoid a) => f a -> f a
  concatMany p = mconcat <$> many p
  
  number :: Parser ATerm
  number = Number <$> decimal
  