{-# LANGUAGE ExistentialQuantification #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Sindre.KeyVal
-- License     :  MIT-style (see LICENSE)
--
-- Stability   :  provisional
-- Portability :  portable
--
-- A simple language for mapping keys to either a single string-value
-- or a list of strings.  The syntax is line-oriented and extremely
-- simple.  A line consists of key-value pairs, which are written as
-- the key, followed by an equals sign, followed by a double-quoted
-- string.  Several double-quoted strings can follow the equal sign,
-- in which case they will be treated as a list.  Space characters
-- separate elements, as so:
--
-- @foo="string" bar="another string" baz="s1" "s2" "this is a list" "s4"@
--
-- Literal double-quotes can be included in a string by doubling them.
--
-- @foo="this string contains ""quotes"""
--
-----------------------------------------------------------------------------
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)

-- | Parse a key-value string wrapper constructed via the permutation
-- parser combinators from 'Text.Parsec.Perm' and the parsers @value@
-- and @values@.
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 k@ is a parser for the single-valued key @k@.
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 k@ is a parser for the list-valued key @k@.  At least a
-- single value is required.
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
' ')