{-# 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
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 ()
= () () -> 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