-- |
-- Module : Data.Herb.Parser
-- Description : Attoparsec interface for Herb
--
-- Attoparsec parser for `Herb` accompanied by a simple compatible formatter.
module Data.Herb.Parser
  ( herb
  , decodeHerb
  , herbFile
  , decodeHerbFile
  ) where

import Data.Herb (FromHerb(..), Herb(..), isEscapable, isUnquotedIdentChar)

import Control.Applicative
import Control.Monad ((>=>), void)
import Data.Attoparsec.Text as P
import Data.Char
import qualified Data.Herb
import qualified Data.Text as T

{-
 - The simple grammar is as follows:
 -
 - - all blanks are insignificant except if quoted, at which point they are
 -   taken verbatim (as literally any other quoted character)
 -
 - - identifier immediately followed by parentheses is a Struct
 -
 - - identifier without parentheses is an Atom
 -
 - - the parenthesized things are split on commas into multiple parameters
 -
 - - identifiers can be delimited by 'quotes' just to be sure, with \' and \\
 -   as only escape sequences (everything else is taken as is)
 -
 - - by default all unquoted identifiers are split on parentheses, commas and
 -   spaces (all of which are "special" in this context)
 -}
quotedChar :: Parser Char
quotedChar :: Parser Char
quotedChar = (Char -> Bool) -> Parser Char
satisfy (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEscapable) Parser Char -> Parser Char -> Parser Char
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Parser Char
char Char
'\\' Parser Char -> Parser Char -> Parser Char
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> Bool) -> Parser Char
satisfy Char -> Bool
isEscapable)

quotedAtom :: Parser T.Text
quotedAtom :: Parser Text
quotedAtom = String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'\'' Parser Char -> Parser Text String -> Parser Text String
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char -> Parser Text String
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Char
quotedChar Parser Text String -> Parser Char -> Parser Text String
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'\'')

unquotedAtom :: Parser T.Text
unquotedAtom :: Parser Text
unquotedAtom = (Char -> Bool) -> Parser Text
P.takeWhile1 Char -> Bool
isUnquotedIdentChar

atom :: Parser Herb
atom :: Parser Herb
atom = do
  r <- Parser Text
unquotedAtom Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
quotedAtom
  x <- peekChar
  case x of
    Just Char
'(' -> String -> Parser Herb
forall a. String -> Parser Text a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"is a struct"
    Maybe Char
_ -> Parser ()
blanks Parser () -> Parser Herb -> Parser Herb
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Herb -> Parser Herb
forall a. a -> Parser Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Herb
Atom Text
r)

blanks :: Parser ()
blanks :: Parser ()
blanks = Parser Text -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text -> Parser ()) -> Parser Text -> Parser ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text
P.takeWhile Char -> Bool
isSpace

comma :: Parser ()
comma :: Parser ()
comma = Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
blanks

parens :: Parser a -> Parser a
parens :: forall a. Parser a -> Parser a
parens Parser a
a = (Char -> Parser Char
char Char
'(' Parser Char -> Parser () -> Parser ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
blanks) Parser () -> Parser a -> Parser a
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
a Parser a -> Parser () -> Parser a
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Char -> Parser Char
char Char
')' Parser Char -> Parser () -> Parser ()
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
blanks)

struct :: Parser Herb
struct :: Parser Herb
struct =
  Text -> [Herb] -> Herb
Struct (Text -> [Herb] -> Herb)
-> Parser Text -> Parser Text ([Herb] -> Herb)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text
unquotedAtom Parser Text -> Parser Text -> Parser Text
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
quotedAtom) Parser Text ([Herb] -> Herb) -> Parser Text [Herb] -> Parser Herb
forall a b. Parser Text (a -> b) -> Parser Text a -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text [Herb] -> Parser Text [Herb]
forall a. Parser a -> Parser a
parens (Parser Herb
herb Parser Herb -> Parser () -> Parser Text [Herb]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Parser ()
comma)

-- | Parser for a single `Herb` term compatible with "Data.Attoparsec.Text".
-- The parsed format is exactly the one produced by `Data.Herb.formatHerb`.
herb :: Parser Herb
herb :: Parser Herb
herb = Parser Herb -> Parser Herb
forall i a. Parser i a -> Parser i a
try Parser Herb
struct Parser Herb -> Parser Herb -> Parser Herb
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Herb
atom

-- | Parse `T.Text` into a single `Herb` structure (reverse of
-- `Data.Herb.formatHerb`).
--
-- To avoid actual parsing into a data structure and decode into "plain Herb",
-- use `Data.Herb.getPlainHerb`.
decodeHerb :: FromHerb a => T.Text -> Either String a
decodeHerb :: forall a. FromHerb a => Text -> Either String a
decodeHerb =
  Parser Herb -> Text -> Either String Herb
forall a. Parser a -> Text -> Either String a
parseOnly (Parser ()
blanks Parser () -> Parser Herb -> Parser Herb
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Herb
herb Parser Herb -> Parser () -> Parser Herb
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput)
    (Text -> Either String Herb)
-> (Herb -> Either String a) -> Text -> Either String a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ((Herb, a) -> a) -> Either String (Herb, a) -> Either String a
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Herb, a) -> a
forall a b. (a, b) -> b
snd (Either String (Herb, a) -> Either String a)
-> (Herb -> Either String (Herb, a)) -> Herb -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Herb a -> Herb -> Either String (Herb, a)
forall h a. Parser h a -> h -> Either String (h, a)
Data.Herb.runParser Parser Herb a
forall a. FromHerb a => Parser Herb a
parseHerb

-- | Parser for multiple `Herb` terms in a file as with `herb`, possibly
-- separated by blanks.
herbFile :: Parser [Herb]
herbFile :: Parser Text [Herb]
herbFile = Parser ()
blanks Parser () -> Parser Text [Herb] -> Parser Text [Herb]
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Herb -> Parser Text [Herb]
forall a. Parser Text a -> Parser Text [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Herb
herb Parser Text [Herb] -> Parser () -> Parser Text [Herb]
forall a b. Parser Text a -> Parser Text b -> Parser Text a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput

-- | Parse `T.Text` that contains multiple structures into a list of `Herb`s.
decodeHerbFile :: FromHerb a => T.Text -> Either String [a]
decodeHerbFile :: forall a. FromHerb a => Text -> Either String [a]
decodeHerbFile =
  Parser Text [Herb] -> Text -> Either String [Herb]
forall a. Parser a -> Text -> Either String a
parseOnly Parser Text [Herb]
herbFile (Text -> Either String [Herb])
-> ([Herb] -> Either String [a]) -> Text -> Either String [a]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (Herb -> Either String a) -> [Herb] -> Either String [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((Herb, a) -> a) -> Either String (Herb, a) -> Either String a
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Herb, a) -> a
forall a b. (a, b) -> b
snd (Either String (Herb, a) -> Either String a)
-> (Herb -> Either String (Herb, a)) -> Herb -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser Herb a -> Herb -> Either String (Herb, a)
forall h a. Parser h a -> h -> Either String (h, a)
Data.Herb.runParser Parser Herb a
forall a. FromHerb a => Parser Herb a
parseHerb)