{-# LANGUAGE TupleSections #-}

module Bio.MAE.Parser
  ( maeP
  , versionP
  , blockP
  , tableP
  ) where

import           Bio.MAE.Type         (Block (..), Mae (..), MaeValue (..),
                                       Table (..))
import           Control.Applicative  ((<|>))
import           Control.Monad        (replicateM, when, zipWithM)
import           Data.Attoparsec.Text (Parser, anyChar, char, decimal,
                                       endOfInput, endOfLine, many', many1',
                                       peekChar, string, takeWhile, takeWhile1)
import           Data.Char            (isSpace)
import           Data.List            (transpose)
import           Data.Map.Strict      (Map)
import qualified Data.Map.Strict      as M (fromList)
import           Data.Text            (Text)
import qualified Data.Text            as T (cons, pack, uncons)
import qualified Data.Text.Read       as TR (decimal, rational, signed)
import           Prelude              hiding (takeWhile)

maeP :: Parser Mae
maeP :: Parser Mae
maeP = Text -> [Block] -> Mae
Mae (Text -> [Block] -> Mae)
-> Parser Text Text -> Parser Text ([Block] -> Mae)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
versionP
           Parser Text ([Block] -> Mae) -> Parser Text [Block] -> Parser Mae
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Block -> Parser Text [Block]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Block
blockP
           Parser Mae -> Parser Text () -> Parser Mae
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput

versionP :: Parser Text
versionP :: Parser Text Text
versionP = Parser Text () -> Parser Text [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text ()
tillEndOfLine Parser Text [()] -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text -> Parser Text Text
forall a. Parser a -> Parser a
inBrackets (Parser Text Text
lineP Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
delimiterP Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
lineP)

blockP :: Parser Block
blockP :: Parser Text Block
blockP = (Map Text MaeValue -> [Table] -> Block)
-> (Map Text MaeValue, [Table]) -> Block
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((Map Text MaeValue -> [Table] -> Block)
 -> (Map Text MaeValue, [Table]) -> Block)
-> Parser Text (Map Text MaeValue -> [Table] -> Block)
-> Parser Text ((Map Text MaeValue, [Table]) -> Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Map Text MaeValue -> [Table] -> Block
Block (Text -> Map Text MaeValue -> [Table] -> Block)
-> Parser Text Text
-> Parser Text (Map Text MaeValue -> [Table] -> Block)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
anyStringP Parser Text (Map Text MaeValue -> [Table] -> Block)
-> Parser Text [Char]
-> Parser Text (Map Text MaeValue -> [Table] -> Block)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Char
oneSpaceP)
                 Parser Text ((Map Text MaeValue, [Table]) -> Block)
-> Parser Text (Map Text MaeValue, [Table]) -> Parser Text Block
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text (Map Text MaeValue, [Table])
-> Parser Text (Map Text MaeValue, [Table])
forall a. Parser a -> Parser a
inBrackets ((,) (Map Text MaeValue -> [Table] -> (Map Text MaeValue, [Table]))
-> Parser Text (Map Text MaeValue)
-> Parser Text ([Table] -> (Map Text MaeValue, [Table]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Map Text MaeValue)
fieldsP Parser Text ([Table] -> (Map Text MaeValue, [Table]))
-> Parser Text [Table] -> Parser Text (Map Text MaeValue, [Table])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Table -> Parser Text [Table]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Table
tableP)
  where
    fieldsP :: Parser (Map Text MaeValue)
    fieldsP :: Parser Text (Map Text MaeValue)
fieldsP = do
        [Text]
fieldNames  <- Parser Text Text -> Parser [Text]
forall a. Parser a -> Parser [a]
upToDelimiterP Parser Text Text
lineP
        [Text]
fieldMaeValues <- Int -> Parser Text Text -> Parser [Text]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
fieldNames) Parser Text Text
lineP

        [(Text, MaeValue)] -> Map Text MaeValue
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, MaeValue)] -> Map Text MaeValue)
-> Parser Text [(Text, MaeValue)]
-> Parser Text (Map Text MaeValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Text -> Parser Text (Text, MaeValue))
-> [Text] -> [Text] -> Parser Text [(Text, MaeValue)]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Text
k Text
v -> (Text
k,) (MaeValue -> (Text, MaeValue))
-> Parser Text MaeValue -> Parser Text (Text, MaeValue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> Parser Text MaeValue
textToMaeValue Text
k Text
v) [Text]
fieldNames [Text]
fieldMaeValues

textToMaeValue :: Text -> Text -> Parser MaeValue
textToMaeValue :: Text -> Text -> Parser Text MaeValue
textToMaeValue Text
k Text
v = if Text
v Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
absentMaeValue then MaeValue -> Parser Text MaeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure MaeValue
Absent else
    case Text -> Maybe (Char, Text)
T.uncons Text
k of
        Just (Char
c, Text
_) -> Char -> Text -> Parser Text MaeValue
getMaeValueReader Char
c Text
v
        Maybe (Char, Text)
_           -> [Char] -> Parser Text MaeValue
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Absent field name."
  where
    absentMaeValue :: Text
    absentMaeValue :: Text
absentMaeValue = Text
"<>"

    getMaeValueReader :: Char -> Text -> Parser MaeValue
    getMaeValueReader :: Char -> Text -> Parser Text MaeValue
getMaeValueReader Char
'i' = Text -> Parser Text MaeValue
textToIntMaeValueReader
    getMaeValueReader Char
'r' = Text -> Parser Text MaeValue
textToRealMaeValueReader
    getMaeValueReader Char
'b' = Text -> Parser Text MaeValue
textToBoolMaeValueReader
    getMaeValueReader Char
's' = Text -> Parser Text MaeValue
textToStringMaeValueReader
    getMaeValueReader Char
_   = Parser Text MaeValue -> Text -> Parser Text MaeValue
forall a b. a -> b -> a
const (Parser Text MaeValue -> Text -> Parser Text MaeValue)
-> Parser Text MaeValue -> Text -> Parser Text MaeValue
forall a b. (a -> b) -> a -> b
$ [Char] -> Parser Text MaeValue
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Unknown value type."

    textToIntMaeValueReader :: Text -> Parser MaeValue
    textToIntMaeValueReader :: Text -> Parser Text MaeValue
textToIntMaeValueReader = ([Char] -> Parser Text MaeValue)
-> ((Int, Text) -> Parser Text MaeValue)
-> Either [Char] (Int, Text)
-> Parser Text MaeValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Parser Text MaeValue
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (MaeValue -> Parser Text MaeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaeValue -> Parser Text MaeValue)
-> ((Int, Text) -> MaeValue) -> (Int, Text) -> Parser Text MaeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MaeValue
IntMaeValue (Int -> MaeValue)
-> ((Int, Text) -> Int) -> (Int, Text) -> MaeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Text) -> Int
forall a b. (a, b) -> a
fst) (Either [Char] (Int, Text) -> Parser Text MaeValue)
-> (Text -> Either [Char] (Int, Text))
-> Text
-> Parser Text MaeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either [Char] (Int, Text))
-> Text -> Either [Char] (Int, Text)
forall a. Num a => Reader a -> Reader a
TR.signed Text -> Either [Char] (Int, Text)
forall a. Integral a => Reader a
TR.decimal

    textToRealMaeValueReader :: Text -> Parser MaeValue
    textToRealMaeValueReader :: Text -> Parser Text MaeValue
textToRealMaeValueReader = ([Char] -> Parser Text MaeValue)
-> ((Float, Text) -> Parser Text MaeValue)
-> Either [Char] (Float, Text)
-> Parser Text MaeValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Parser Text MaeValue
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (MaeValue -> Parser Text MaeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaeValue -> Parser Text MaeValue)
-> ((Float, Text) -> MaeValue)
-> (Float, Text)
-> Parser Text MaeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> MaeValue
RealMaeValue (Float -> MaeValue)
-> ((Float, Text) -> Float) -> (Float, Text) -> MaeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float, Text) -> Float
forall a b. (a, b) -> a
fst) (Either [Char] (Float, Text) -> Parser Text MaeValue)
-> (Text -> Either [Char] (Float, Text))
-> Text
-> Parser Text MaeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either [Char] (Float, Text))
-> Text -> Either [Char] (Float, Text)
forall a. Num a => Reader a -> Reader a
TR.signed Text -> Either [Char] (Float, Text)
forall a. Fractional a => Reader a
TR.rational

    textToBoolMaeValueReader :: Text -> Parser MaeValue
    textToBoolMaeValueReader :: Text -> Parser Text MaeValue
textToBoolMaeValueReader Text
t =
        case Text
t of
            Text
"0" -> MaeValue -> Parser Text MaeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaeValue -> Parser Text MaeValue)
-> MaeValue -> Parser Text MaeValue
forall a b. (a -> b) -> a -> b
$ Bool -> MaeValue
BoolMaeValue Bool
False
            Text
"1" -> MaeValue -> Parser Text MaeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaeValue -> Parser Text MaeValue)
-> MaeValue -> Parser Text MaeValue
forall a b. (a -> b) -> a -> b
$ Bool -> MaeValue
BoolMaeValue Bool
True
            Text
_   -> [Char] -> Parser Text MaeValue
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Can't parse bool value."

    textToStringMaeValueReader :: Text -> Parser MaeValue
    textToStringMaeValueReader :: Text -> Parser Text MaeValue
textToStringMaeValueReader = MaeValue -> Parser Text MaeValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MaeValue -> Parser Text MaeValue)
-> (Text -> MaeValue) -> Text -> Parser Text MaeValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> MaeValue
StringMaeValue

tableP :: Parser Table
tableP :: Parser Text Table
tableP = do
    Text
name            <- Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Char
oneSpaceP Parser Text [Char] -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
leftSquareBracket)
    Int
numberOfEntries <- Char -> Parser Text Char
char Char
leftSquareBracket Parser Text Char -> Parser Text Int -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Int
forall a. Integral a => Parser a
decimal Parser Text Int -> Parser Text Char -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
rightSquareBracket

    [Char]
_ <- Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Char
oneSpaceP

    Map Text [MaeValue]
contents <- Parser (Map Text [MaeValue]) -> Parser (Map Text [MaeValue])
forall a. Parser a -> Parser a
inBrackets (Parser (Map Text [MaeValue]) -> Parser (Map Text [MaeValue]))
-> Parser (Map Text [MaeValue]) -> Parser (Map Text [MaeValue])
forall a b. (a -> b) -> a -> b
$ do
        [Text]
fieldNames  <- Parser Text Text -> Parser [Text]
forall a. Parser a -> Parser [a]
upToDelimiterP Parser Text Text
lineP
        let readers :: [Text -> Parser Text MaeValue]
readers = (Text -> Text -> Parser Text MaeValue)
-> [Text] -> [Text -> Parser Text MaeValue]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text -> Parser Text MaeValue
textToMaeValue [Text]
fieldNames
        [[MaeValue]]
entries     <- Int -> Parser Text [MaeValue] -> Parser Text [[MaeValue]]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
numberOfEntries (Parser Text [MaeValue] -> Parser Text [[MaeValue]])
-> Parser Text [MaeValue] -> Parser Text [[MaeValue]]
forall a b. (a -> b) -> a -> b
$ [Text -> Parser Text MaeValue] -> Parser Text [MaeValue]
entryP [Text -> Parser Text MaeValue]
readers

        Parser Text ()
delimiterP

        Map Text [MaeValue] -> Parser (Map Text [MaeValue])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Text [MaeValue] -> Parser (Map Text [MaeValue]))
-> Map Text [MaeValue] -> Parser (Map Text [MaeValue])
forall a b. (a -> b) -> a -> b
$ [(Text, [MaeValue])] -> Map Text [MaeValue]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, [MaeValue])] -> Map Text [MaeValue])
-> [(Text, [MaeValue])] -> Map Text [MaeValue]
forall a b. (a -> b) -> a -> b
$ [Text] -> [[MaeValue]] -> [(Text, [MaeValue])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
fieldNames ([[MaeValue]] -> [(Text, [MaeValue])])
-> [[MaeValue]] -> [(Text, [MaeValue])]
forall a b. (a -> b) -> a -> b
$ [[MaeValue]] -> [[MaeValue]]
forall a. [[a]] -> [[a]]
transpose [[MaeValue]]
entries

    Table -> Parser Text Table
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Table -> Parser Text Table) -> Table -> Parser Text Table
forall a b. (a -> b) -> a -> b
$ Text -> Map Text [MaeValue] -> Table
Table Text
name Map Text [MaeValue]
contents
  where
    leftSquareBracket :: Char
    leftSquareBracket :: Char
leftSquareBracket = Char
'['

    rightSquareBracket :: Char
    rightSquareBracket :: Char
rightSquareBracket = Char
']'

    entryP :: [Text -> Parser MaeValue] -> Parser [MaeValue]
    entryP :: [Text -> Parser Text MaeValue] -> Parser Text [MaeValue]
entryP [Text -> Parser Text MaeValue]
readers = do
        [Text]
valuesT <- Parser Text Text -> Parser [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' (Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Char
oneSpaceP Parser Text [Char] -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
valueTP Parser Text Text -> Parser Text [Char] -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Char
oneSpaceP) Parser [Text] -> Parser Text () -> Parser [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
tillEndOfLine
        Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Text -> Parser Text MaeValue] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text -> Parser Text MaeValue]
readers Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
valuesT Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Parser Text () -> Parser Text ())
-> Parser Text () -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Parser Text ()
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Wrong number of values in an entry."
        ((Text -> Parser Text MaeValue) -> Text -> Parser Text MaeValue)
-> [Text -> Parser Text MaeValue]
-> [Text]
-> Parser Text [MaeValue]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Text -> Parser Text MaeValue) -> Text -> Parser Text MaeValue
forall a b. (a -> b) -> a -> b
($) [Text -> Parser Text MaeValue]
readers ([Text] -> Parser Text [MaeValue])
-> [Text] -> Parser Text [MaeValue]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 [Text]
valuesT

--------------------------------------------------------------------------------
-- Utility functions.
--------------------------------------------------------------------------------

inBrackets :: Parser a -> Parser a
inBrackets :: Parser a -> Parser a
inBrackets Parser a
p =  Char -> Parser Text Char
char Char
leftBracket Parser Text Char -> Parser Text [()] -> Parser Text [()]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text () -> Parser Text [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser Text ()
tillEndOfLine
             Parser Text [()] -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p
             Parser a -> Parser Text [Char] -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Char
oneSpaceP Parser a -> Parser Text Char -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
char Char
rightBracket Parser a -> Parser Text [()] -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text () -> Parser Text [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many1' Parser Text ()
tillEndOfLine
  where
    leftBracket :: Char
    leftBracket :: Char
leftBracket = Char
'{'

    rightBracket :: Char
    rightBracket :: Char
rightBracket = Char
'}'

delimiterP :: Parser ()
delimiterP :: Parser Text ()
delimiterP = Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Char
oneSpaceP Parser Text [Char] -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Text
string Text
delimiter Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
tillEndOfLine
  where
    delimiter :: Text
    delimiter :: Text
delimiter = Text
":::"

upToDelimiterP :: Parser a -> Parser [a]
upToDelimiterP :: Parser a -> Parser [a]
upToDelimiterP Parser a
p = ([] [a] -> Parser Text () -> Parser [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text ()
delimiterP) Parser [a] -> Parser [a] -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((:) (a -> [a] -> [a]) -> Parser a -> Parser Text ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p Parser Text ([a] -> [a]) -> Parser [a] -> Parser [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
upToDelimiterP Parser a
p)

oneSpaceP :: Parser Char
oneSpaceP :: Parser Text Char
oneSpaceP = Char -> Parser Text Char
char Char
' '

anyStringP :: Parser Text
anyStringP :: Parser Text Text
anyStringP = (Char -> Bool) -> Parser Text Text
takeWhile1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)

valueTP :: Parser Text
valueTP :: Parser Text Text
valueTP  =  (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (Text -> Text -> Text)
-> Parser Text Text -> Parser Text (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Text Text
string Text
quoteT Parser Text (Text -> Text) -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) (Text -> Text -> Text)
-> Parser Text Text -> Parser Text (Text -> Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
notQuote Parser Text (Text -> Text) -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> Parser Text Text
string Text
quoteT))
        Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
anyStringP
  where
    quote :: Char
    quote :: Char
quote = Char
'\"'

    quoteT :: Text
    quoteT :: Text
quoteT = [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Char -> [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
quote

    notQuote :: Parser Text
    notQuote :: Parser Text Text
notQuote = do
        Maybe Char
curCharPeek <- Parser (Maybe Char)
peekChar
        case Maybe Char
curCharPeek of
          Just Char
'\\' -> do
              Char
curChar <- Parser Text Char
anyChar
              Maybe Char
nextCharPeek <- Parser (Maybe Char)
peekChar
              case Maybe Char
nextCharPeek of
                Just Char
'\"' -> Parser Text Char
anyChar Parser Text Char -> (Char -> Parser Text Text) -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
x -> (Text -> Text) -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> Text -> Text
T.cons Char
curChar (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.cons Char
x) Parser Text Text
notQuote
                Maybe Char
_          -> Parser Text Text
notQuote Parser Text Text -> (Text -> Parser Text Text) -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Parser Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Parser Text Text)
-> (Text -> Text) -> Text -> Parser Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text -> Text
T.cons Char
curChar
          Just Char
'\"' -> Text -> Parser Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
forall a. Monoid a => a
mempty
          Just Char
_    -> Parser Text Char
anyChar Parser Text Char -> (Char -> Parser Text Text) -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
x -> (Text -> Text) -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char -> Text -> Text
T.cons Char
x) Parser Text Text
notQuote
          Maybe Char
Nothing   -> Text -> Parser Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
forall a. Monoid a => a
mempty

commentaryP :: Parser ()
commentaryP :: Parser Text ()
commentaryP = () () -> Parser Text [()] -> Parser Text ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text () -> Parser Text [()]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' (Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Char
oneSpaceP Parser Text [Char] -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text Char
char Char
'#' Parser Text Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Bool) -> Parser Text Text
takeWhile (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'\n', Char
'\r']) Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
endOfLine)

lineP :: Parser Text
lineP :: Parser Text Text
lineP = Parser Text ()
commentaryP Parser Text () -> Parser Text [Char] -> Parser Text [Char]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Char
oneSpaceP Parser Text [Char] -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
valueTP Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
tillEndOfLine Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
commentaryP

tillEndOfLine :: Parser ()
tillEndOfLine :: Parser Text ()
tillEndOfLine = () () -> Parser Text [Char] -> Parser Text ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text Char -> Parser Text [Char]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many' Parser Text Char
oneSpaceP Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
endOfLine