{-# LANGUAGE ExistentialQuantification #-}
module Sindre.KeyVal( parseKV
, value
, values
, (<$?>)
, (<||>)
, (<$$>)
, (<|?>) )
where
import Control.Applicative hiding (many, empty)
import Control.Monad.Identity
import Data.Attoparsec.Combinator
import Data.Attoparsec.Text
import qualified Data.Text as T
import Text.ParserCombinators.Perm
import Prelude hiding (takeWhile)
parseKV :: PermParser Parser a -> T.Text -> Either String a
parseKV :: PermParser Parser a -> Text -> Either String a
parseKV PermParser Parser a
p Text
s =
Result a -> Either String a
forall r. Result r -> Either String r
eitherResult (Result a -> Either String a) -> Result a -> Either String a
forall a b. (a -> b) -> a -> b
$ Parser a -> Text -> Result a
forall a. Parser a -> Text -> Result a
parse (PermParser Parser a -> Parser a
forall (p :: * -> *) a.
(Alternative p, Monad p) =>
PermParser p a -> p a
permute PermParser Parser a
p Parser a -> Parser () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall t. Chunk t => Parser t ()
endOfInput) Text
s Result a -> Text -> Result a
forall i r. Monoid i => IResult i r -> i -> IResult i r
`feed` Text
T.empty
value :: T.Text -> Parser T.Text
value :: Text -> Parser Text
value Text
k = Parser Text -> Parser Text
forall i a. Parser i a -> Parser i a
try (Text -> Parser Text
string Text
k) Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
realSpaces Parser Text -> 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 -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
realSpaces
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
quotedString Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
realSpaces
values :: T.Text -> Parser [T.Text]
values :: Text -> Parser [Text]
values Text
k = Parser Text -> Parser Text
forall i a. Parser i a -> Parser i a
try (Text -> Parser Text
string Text
k) Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
realSpaces Parser Text -> 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 -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
realSpaces
Parser Text -> Parser [Text] -> Parser [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text -> Parser [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text
quotedString Parser [Text] -> Parser Text -> Parser [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
realSpaces
quotedString :: Parser T.Text
quotedString :: Parser Text
quotedString = Char -> Parser Text Char
char Char
'"' Parser Text Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
inner Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text
realSpaces
where inner :: Parser Text
inner = do
Text
s <- (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'"')
Char -> Parser Text Char
char Char
'\"' Parser Text Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Parser Text Char
char Char
'\"' Parser Text Char -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Text -> Text
T.append (Text -> Char -> Text
T.snoc Text
s Char
'"') (Text -> Text) -> Parser Text -> Parser Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
inner)
Parser Text -> Parser Text -> Parser Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s)
realSpaces :: Parser T.Text
realSpaces :: Parser Text
realSpaces = (Char -> Bool) -> Parser Text
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
' ')