{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
module Text.ICalendar.Parser.Common where

import           Control.Applicative
import           Control.Arrow                (second)
import           Control.Monad                (when, unless, (<=<))
import           Control.Monad.Except         hiding (mapM)
import           Control.Monad.RWS            (MonadState (get, put),
                                               MonadWriter (tell), RWS, asks,
                                               modify)
import qualified Data.ByteString.Builder      as Bu
import           Data.ByteString.Lazy.Char8   (ByteString)
import qualified Data.ByteString.Lazy.Char8   as B
import           Data.CaseInsensitive         (CI)
import qualified Data.CaseInsensitive         as CI
import           Data.Char
import           Data.Default
import           Data.List                    (partition)
import           Data.Maybe
import           Data.Monoid
import           Data.Set                     (Set)
import qualified Data.Set                     as S
import           Data.Text.Lazy               (Text)
import qualified Data.Text.Lazy               as T
import qualified Data.Text.Lazy.Encoding      as TE
import           Data.Time                    (Day, LocalTime (LocalTime),
                                               TimeOfDay (), UTCTime (UTCTime))
import qualified Data.Time                    as Time
import           Data.Traversable             (mapM)
import qualified Network.URI                  as URI
import           Prelude                      hiding (mapM)

#if MIN_VERSION_time(1,5,0)
import Data.Time (defaultTimeLocale)
#else
import System.Locale (defaultTimeLocale)
#endif

import qualified Text.Parsec            as P
import           Text.Parsec.Combinator hiding (optional)
import           Text.Parsec.Prim       hiding ((<|>))

import Text.ICalendar.Types

-- | Content lines, separated into components. 3.1.
data Content = ContentLine P.SourcePos (CI Text) [(CI Text, [Text])] ByteString
             | Component P.SourcePos (CI Text) [Content]
               deriving (Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
(Int -> Content -> ShowS)
-> (Content -> String) -> ([Content] -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Content -> ShowS
showsPrec :: Int -> Content -> ShowS
$cshow :: Content -> String
show :: Content -> String
$cshowList :: [Content] -> ShowS
showList :: [Content] -> ShowS
Show, Content -> Content -> Bool
(Content -> Content -> Bool)
-> (Content -> Content -> Bool) -> Eq Content
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
/= :: Content -> Content -> Bool
Eq, Eq Content
Eq Content =>
(Content -> Content -> Ordering)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Content)
-> (Content -> Content -> Content)
-> Ord Content
Content -> Content -> Bool
Content -> Content -> Ordering
Content -> Content -> Content
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Content -> Content -> Ordering
compare :: Content -> Content -> Ordering
$c< :: Content -> Content -> Bool
< :: Content -> Content -> Bool
$c<= :: Content -> Content -> Bool
<= :: Content -> Content -> Bool
$c> :: Content -> Content -> Bool
> :: Content -> Content -> Bool
$c>= :: Content -> Content -> Bool
>= :: Content -> Content -> Bool
$cmax :: Content -> Content -> Content
max :: Content -> Content -> Content
$cmin :: Content -> Content -> Content
min :: Content -> Content -> Content
Ord)

type TextParser = P.Parsec ByteString DecodingFunctions

type ContentParser = ExceptT String -- Fatal errors.
                            (RWS DecodingFunctions
                                 [String] -- Warnings.
                                 (P.SourcePos, [Content]))

-- | Functions for decoding 'ByteString's into 'Text'.
data DecodingFunctions = DecodingFunctions
    { DecodingFunctions -> ByteString -> Text
dfBS2Text  :: ByteString -> Text
    , DecodingFunctions -> ByteString -> CI Text
dfBS2IText :: ByteString -> CI Text
    }

-- | UTF8.
instance Default DecodingFunctions where
    def :: DecodingFunctions
def = (ByteString -> Text)
-> (ByteString -> CI Text) -> DecodingFunctions
DecodingFunctions ByteString -> Text
TE.decodeUtf8 (Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> CI Text) -> (ByteString -> Text) -> ByteString -> CI Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TE.decodeUtf8)

-- | Parse text. 3.3.11
parseText' :: ByteString -> ContentParser ([Text], ByteString)
parseText' :: ByteString -> ContentParser ([Text], ByteString)
parseText' ByteString
bs = do ByteString -> Text
c <- (DecodingFunctions -> ByteString -> Text)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (ByteString -> Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DecodingFunctions -> ByteString -> Text
dfBS2Text
                   case Parsec ByteString () ([Builder], ByteString)
-> ()
-> String
-> ByteString
-> Either ParseError ([Builder], ByteString)
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser ((,) ([Builder] -> ByteString -> ([Builder], ByteString))
-> ParsecT ByteString () Identity [Builder]
-> ParsecT
     ByteString () Identity (ByteString -> ([Builder], ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString () Identity [Builder]
forall {u}. ParsecT ByteString u Identity [Builder]
texts ParsecT
  ByteString () Identity (ByteString -> ([Builder], ByteString))
-> ParsecT ByteString () Identity ByteString
-> Parsec ByteString () ([Builder], ByteString)
forall a b.
ParsecT ByteString () Identity (a -> b)
-> ParsecT ByteString () Identity a
-> ParsecT ByteString () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT ByteString () Identity ByteString
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput) () String
"text" ByteString
bs of
                        Left ParseError
e -> String -> ContentParser ([Text], ByteString)
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser ([Text], ByteString))
-> String -> ContentParser ([Text], ByteString)
forall a b. (a -> b) -> a -> b
$ String
"parseText': " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> String
forall a. Show a => a -> String
show ParseError
e
                        Right ([Builder]
x, ByteString
r) -> ([Text], ByteString) -> ContentParser ([Text], ByteString)
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return ( (Builder -> Text) -> [Builder] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Text
c (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Bu.toLazyByteString) [Builder]
x
                                               , ByteString
r)
  where texts :: ParsecT ByteString u Identity [Builder]
texts = ParsecT ByteString u Identity Builder
-> ParsecT ByteString u Identity Char
-> ParsecT ByteString u Identity [Builder]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 ParsecT ByteString u Identity Builder
forall {u}. ParsecT ByteString u Identity Builder
text (Char -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
',') ParsecT ByteString u Identity [Builder]
-> ParsecT ByteString u Identity [Builder]
-> ParsecT ByteString u Identity [Builder]
forall a.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Builder] -> ParsecT ByteString u Identity [Builder]
forall a. a -> ParsecT ByteString u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return [Builder
forall a. Monoid a => a
mempty]
        text :: ParsecT ByteString u Identity Builder
text = do Char
x <- (Char -> Bool) -> ParsecT ByteString u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
P.satisfy Char -> Bool
isTSafe'
                  case Char
x of
                       Char
'\\' -> do Char
y <- ParsecT ByteString u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.anyChar
                                  case Char
y of
                                       Char
'\\' -> Char -> ParsecT ByteString u Identity Builder
nxt Char
'\\'
                                       Char
';' -> Char -> ParsecT ByteString u Identity Builder
nxt Char
';'
                                       Char
',' -> Char -> ParsecT ByteString u Identity Builder
nxt Char
','
                                       Char
z | Char
z Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'n',Char
'N'] -> Char -> ParsecT ByteString u Identity Builder
nxt Char
'\n'
                                       Char
_ -> String -> ParsecT ByteString u Identity Builder
forall a. String -> ParsecT ByteString u Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT ByteString u Identity Builder)
-> String -> ParsecT ByteString u Identity Builder
forall a b. (a -> b) -> a -> b
$ String
"unexpected " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
x
                       Char
y -> Char -> ParsecT ByteString u Identity Builder
nxt Char
y
        -- isTSafe + 0x22, 0x3A, and 0x5C is pattern matched against.
        isTSafe' :: Char -> Bool
isTSafe' Char
c = let n :: Int
n = Char -> Int
ord Char
c
                      in Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
9 Bool -> Bool -> Bool
|| (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x20 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x2B)
                                Bool -> Bool -> Bool
|| (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x2D Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0x3A)
                                Bool -> Bool -> Bool
|| (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0x3C Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0x7F)
        nxt :: Char -> ParsecT ByteString u Identity Builder
nxt Char
c = (Char -> Builder
Bu.char8 Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>) (Builder -> Builder)
-> ParsecT ByteString u Identity Builder
-> ParsecT ByteString u Identity Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT ByteString u Identity Builder
text ParsecT ByteString u Identity Builder
-> ParsecT ByteString u Identity Builder
-> ParsecT ByteString u Identity Builder
forall a.
ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
-> ParsecT ByteString u Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Builder -> ParsecT ByteString u Identity Builder
forall a. a -> ParsecT ByteString u Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Builder
forall a. Monoid a => a
mempty)

-- | Chech that there's no remainding text after the parser is done.
noRestText :: ([Text], ByteString) -> ContentParser [Text]
noRestText :: ([Text], ByteString) -> ContentParser [Text]
noRestText ([Text]
x, ByteString
"") = [Text] -> ContentParser [Text]
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
x
noRestText ([Text]
_, ByteString
x) = String -> ContentParser [Text]
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser [Text]) -> String -> ContentParser [Text]
forall a b. (a -> b) -> a -> b
$ String
"noRestText: remainding text: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
x

-- | Parse text, not allowing any remainding text.
parseText :: ByteString -> ContentParser [Text]
parseText :: ByteString -> ContentParser [Text]
parseText = ([Text], ByteString) -> ContentParser [Text]
noRestText (([Text], ByteString) -> ContentParser [Text])
-> (ByteString -> ContentParser ([Text], ByteString))
-> ByteString
-> ContentParser [Text]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> ContentParser ([Text], ByteString)
parseText'

-- | Parse a DateTime value. 3.3.5
parseDateTime :: Maybe Text -- ^ Time Zone ID
              -> ByteString -> ContentParser DateTime
parseDateTime :: Maybe Text -> ByteString -> ContentParser DateTime
parseDateTime Maybe Text
mTZ ByteString
bs = do
    String
str <- (DecodingFunctions -> String)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((DecodingFunctions -> String)
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      String)
-> (DecodingFunctions -> String)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String)
-> (DecodingFunctions -> Text) -> DecodingFunctions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
bs) ((ByteString -> Text) -> Text)
-> (DecodingFunctions -> ByteString -> Text)
-> DecodingFunctions
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodingFunctions -> ByteString -> Text
dfBS2Text
    let dayRes :: Maybe (Day, String)
dayRes = String -> Maybe (Day, String)
parseDateStr String
str
        Just (Day
day, String
rest') = Maybe (Day, String)
dayRes
        t :: String
t = Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
1 String
rest'
        timeRes :: Maybe (TimeOfDay, Bool)
timeRes = String -> Maybe (TimeOfDay, Bool)
parseTimeStr (String -> Maybe (TimeOfDay, Bool))
-> String -> Maybe (TimeOfDay, Bool)
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 String
rest'
        Just (TimeOfDay
time, Bool
isUTC) = Maybe (TimeOfDay, Bool)
timeRes
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (TimeOfDay, Bool) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe (Day, String)
dayRes Maybe (Day, String)
-> Maybe (TimeOfDay, Bool) -> Maybe (TimeOfDay, Bool)
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (TimeOfDay, Bool)
timeRes) Bool -> Bool -> Bool
|| String
t String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"T") (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> (String
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$ String
"parseDateTime: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
isUTC Bool -> Bool -> Bool
&& Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust Maybe Text
mTZ) (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$
        [String]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"parseDateTime: TZID on UTC timezone: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str]
    DateTime -> ContentParser DateTime
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (DateTime -> ContentParser DateTime)
-> DateTime -> ContentParser DateTime
forall a b. (a -> b) -> a -> b
$ case (Maybe Text
mTZ, Bool
isUTC) of
                  (Maybe Text
Nothing, Bool
False) -> LocalTime -> DateTime
FloatingDateTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
time)
                  (Just Text
tz, Bool
False) -> LocalTime -> Text -> DateTime
ZonedDateTime (Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
time) Text
tz
                  (Maybe Text
_, Bool
True) -> UTCTime -> DateTime
UTCDateTime (Day -> DiffTime -> UTCTime
UTCTime Day
day
                                                  (DiffTime -> UTCTime) -> DiffTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ TimeOfDay -> DiffTime
Time.timeOfDayToTime TimeOfDay
time)

-- | Parse a string to a Day. 3.3.4
parseDateStr :: String -> Maybe (Day, String)
parseDateStr :: String -> Maybe (Day, String)
parseDateStr = [(Day, String)] -> Maybe (Day, String)
forall a. [a] -> Maybe a
lastToMaybe ([(Day, String)] -> Maybe (Day, String))
-> (String -> [(Day, String)]) -> String -> Maybe (Day, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> TimeLocale -> String -> String -> [(Day, String)]
forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
Time.readSTime Bool
True TimeLocale
defaultTimeLocale String
"%Y%m%d"

-- | Parse a string to a TimeOfDay, and a bool if it's in UTC.
parseTimeStr :: String -> Maybe (TimeOfDay, Bool)
parseTimeStr :: String -> Maybe (TimeOfDay, Bool)
parseTimeStr String
s = do
    (TimeOfDay
t, String
r) <- [(TimeOfDay, String)] -> Maybe (TimeOfDay, String)
forall a. [a] -> Maybe a
lastToMaybe (Bool -> TimeLocale -> String -> ReadS TimeOfDay
forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
Time.readSTime Bool
True TimeLocale
defaultTimeLocale String
"%H%M%S" String
s)
    case String
r of
         String
"Z" -> (TimeOfDay, Bool) -> Maybe (TimeOfDay, Bool)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeOfDay
t, Bool
True)
         String
"" -> (TimeOfDay, Bool) -> Maybe (TimeOfDay, Bool)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (TimeOfDay
t, Bool
False)
         String
_ -> String -> Maybe (TimeOfDay, Bool)
forall a. String -> Maybe a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
""

-- | Parse a Date value. 3.3.4
parseDate :: ByteString -> ContentParser Date
parseDate :: ByteString -> ContentParser Date
parseDate ByteString
bs = do
    String
str <- (DecodingFunctions -> String)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ((DecodingFunctions -> String)
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      String)
-> (DecodingFunctions -> String)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String)
-> (DecodingFunctions -> Text) -> DecodingFunctions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
bs) ((ByteString -> Text) -> Text)
-> (DecodingFunctions -> ByteString -> Text)
-> DecodingFunctions
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodingFunctions -> ByteString -> Text
dfBS2Text
    let dayRes :: Maybe (Day, String)
dayRes = String -> Maybe (Day, String)
parseDateStr String
str
        Just (Day
day, String
rest) = Maybe (Day, String)
dayRes
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe (Day, String) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Day, String)
dayRes) (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> (String
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$ String
"parseDate: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
str
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
rest) (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$
        [String]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"parseDate: extra content: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
rest]
    Date -> ContentParser Date
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Date -> ContentParser Date) -> Date -> ContentParser Date
forall a b. (a -> b) -> a -> b
$ Day -> Date
Date Day
day

-- {{{ Misc parsers

parseURI :: String -> ContentParser URI.URI
parseURI :: String -> ContentParser URI
parseURI String
s = case String -> Maybe URI
URI.parseURI String
s of
                  Just URI
x -> URI -> ContentParser URI
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return URI
x
                  Maybe URI
Nothing -> String -> ContentParser URI
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser URI) -> String -> ContentParser URI
forall a b. (a -> b) -> a -> b
$  String
"Invalid URI: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s

-- | Convert a 'DateTime' to 'UTCTime', giving an appropriate error.
mustBeUTC :: DateTime -> ContentParser UTCTime
mustBeUTC :: DateTime -> ContentParser UTCTime
mustBeUTC (UTCDateTime UTCTime
x) = UTCTime -> ContentParser UTCTime
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return UTCTime
x
mustBeUTC DateTime
_ = String -> ContentParser UTCTime
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"DateTime-value must be UTC"

-- | Parse something simple with only a Text-field for the content, and
-- 'OtherParams'.
parseSimple :: (Text -> OtherParams -> b) -> Content -> ContentParser b
parseSimple :: forall b. (Text -> OtherParams -> b) -> Content -> ContentParser b
parseSimple Text -> OtherParams -> b
k (ContentLine SourcePos
_ CI Text
_ [(CI Text, [Text])]
o ByteString
bs) = do Text
c <- [Text] -> ContentParser Text
forall a. [a] -> ContentParser a
valueOnlyOne ([Text] -> ContentParser Text)
-> ContentParser [Text] -> ContentParser Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> ContentParser [Text]
parseText ByteString
bs
                                          b -> ContentParser b
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ContentParser b) -> b -> ContentParser b
forall a b. (a -> b) -> a -> b
$ Text -> OtherParams -> b
k Text
c ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o)
parseSimple Text -> OtherParams -> b
_ Content
x = String -> ContentParser b
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser b) -> String -> ContentParser b
forall a b. (a -> b) -> a -> b
$ String
"parseSimple: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse something simple with only a CI Text-field for the content, and
-- 'OtherParams'.
parseSimpleI :: (CI Text -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleI :: forall b.
(CI Text -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleI CI Text -> OtherParams -> b
k (ContentLine SourcePos
_ CI Text
_ [(CI Text, [Text])]
o ByteString
bs) = do ByteString -> CI Text
c <- (DecodingFunctions -> ByteString -> CI Text)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (ByteString -> CI Text)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks DecodingFunctions -> ByteString -> CI Text
dfBS2IText
                                           b -> ContentParser b
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ContentParser b) -> b -> ContentParser b
forall a b. (a -> b) -> a -> b
$ CI Text -> OtherParams -> b
k (ByteString -> CI Text
c ByteString
bs) ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o)
parseSimpleI CI Text -> OtherParams -> b
_ Content
x = String -> ContentParser b
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser b) -> String -> ContentParser b
forall a b. (a -> b) -> a -> b
$ String
"parseSimpleI: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse something simple with only a Int-field for the content, and
-- 'OtherParams'.
parseSimpleRead :: forall a b. Read a
                => (a -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleRead :: forall a b.
Read a =>
(a -> OtherParams -> b) -> Content -> ContentParser b
parseSimpleRead a -> OtherParams -> b
k (ContentLine SourcePos
_ CI Text
_ [(CI Text, [Text])]
o ByteString
bs) = do
    let r :: Maybe a
r = String -> Maybe a
forall a. Read a => String -> Maybe a
maybeRead (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B.unpack ByteString
bs :: Maybe a
    Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
r) (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> (String
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$ String
"parseSimpleRead: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
bs
    b -> ContentParser b
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> ContentParser b) -> b -> ContentParser b
forall a b. (a -> b) -> a -> b
$ a -> OtherParams -> b
k (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
r) ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o)
parseSimpleRead a -> OtherParams -> b
_ Content
x = String -> ContentParser b
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser b) -> String -> ContentParser b
forall a b. (a -> b) -> a -> b
$ String
"parseSimpleRead: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse something b with alternative representations, language
-- specification, and 'OtherParams'.
parseAltRepLang' :: ([Text] -> ContentParser b)
                 -> (b -> Maybe URI.URI -> Maybe Language -> OtherParams -> a)
                 -> Content -> ContentParser a
parseAltRepLang' :: forall b a.
([Text] -> ContentParser b)
-> (b -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content
-> ContentParser a
parseAltRepLang' [Text] -> ContentParser b
m b -> Maybe URI -> Maybe Language -> OtherParams -> a
f (ContentLine SourcePos
_ CI Text
_ [(CI Text, [Text])]
o ByteString
bs) = do
    b
t <- [Text] -> ContentParser b
m ([Text] -> ContentParser b)
-> ContentParser [Text] -> ContentParser b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> ContentParser [Text]
parseText ByteString
bs
    Maybe URI
uri <- ([String] -> ContentParser URI)
-> Maybe [String]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe URI)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM (String -> ContentParser URI
parseURI (String -> ContentParser URI)
-> ([String]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         String)
-> [String]
-> ContentParser URI
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [String]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
forall a. [a] -> ContentParser a
paramOnlyOne) (Maybe [String]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe URI))
-> Maybe [String]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe URI)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Maybe [Text] -> Maybe [String]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"ALTREP" [(CI Text, [Text])]
o
    Maybe Language
lang <- ([Language]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      Language)
-> Maybe [Language]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Language)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Language]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     Language
forall a. [a] -> ContentParser a
paramOnlyOne (Maybe [Language]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Language))
-> Maybe [Language]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Language)
forall a b. (a -> b) -> a -> b
$ CI Text -> Language
Language (CI Text -> Language) -> (Text -> CI Text) -> Text -> Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Text -> Language) -> Maybe [Text] -> Maybe [Language]
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"LANGUAGE" [(CI Text, [Text])]
o
    let o' :: [(CI Text, [Text])]
o' = ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(CI Text
x, [Text]
_) -> CI Text
x CI Text -> [CI Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CI Text
"ALTREP", CI Text
"LANGUAGE"]) [(CI Text, [Text])]
o
    a -> ContentParser a
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ContentParser a) -> a -> ContentParser a
forall a b. (a -> b) -> a -> b
$ b -> Maybe URI -> Maybe Language -> OtherParams -> a
f b
t Maybe URI
uri Maybe Language
lang ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o')
parseAltRepLang' [Text] -> ContentParser b
_ b -> Maybe URI -> Maybe Language -> OtherParams -> a
_ Content
x = String -> ContentParser a
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser a) -> String -> ContentParser a
forall a b. (a -> b) -> a -> b
$ String
"parseAltRepLang': " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse something 'Text' with alternative representations, language
-- specification, and 'OtherParams'.
parseAltRepLang :: (Text -> Maybe URI.URI -> Maybe Language -> OtherParams -> a)
                -> Content -> ContentParser a
parseAltRepLang :: forall a.
(Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLang = ([Text] -> ContentParser Text)
-> (Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content
-> ContentParser a
forall b a.
([Text] -> ContentParser b)
-> (b -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content
-> ContentParser a
parseAltRepLang' [Text] -> ContentParser Text
lenientTextOnlyOne
  where lenientTextOnlyOne :: [Text] -> ContentParser Text
        lenientTextOnlyOne :: [Text] -> ContentParser Text
lenientTextOnlyOne [Text
x] = Text -> ContentParser Text
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
x
        lenientTextOnlyOne [] = String -> ContentParser Text
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Must have one value, not zero."
        lenientTextOnlyOne [Text]
xs = do
            [String]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
"Illegal comma in value that only allows one TEXT, assuming literal comma was intended."]
            Text -> ContentParser Text
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ContentParser Text) -> Text -> ContentParser Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"," [Text]
xs

-- | Parse something '[Text]' with alternative representations, language
-- specification, and 'OtherParams'.
parseAltRepLangN :: (Set Text -> Maybe URI.URI -> Maybe Language
                              -> OtherParams -> a)
                -> Content -> ContentParser a
parseAltRepLangN :: forall a.
(Set Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content -> ContentParser a
parseAltRepLangN = ([Text] -> ContentParser (Set Text))
-> (Set Text -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content
-> ContentParser a
forall b a.
([Text] -> ContentParser b)
-> (b -> Maybe URI -> Maybe Language -> OtherParams -> a)
-> Content
-> ContentParser a
parseAltRepLang' (Set Text -> ContentParser (Set Text)
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Set Text -> ContentParser (Set Text))
-> ([Text] -> Set Text) -> [Text] -> ContentParser (Set Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList)

-- | Parse something simple with only a URI-field for the content, and
-- 'OtherParams'.
parseSimpleURI :: (URI.URI -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleURI :: forall a. (URI -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleURI URI -> OtherParams -> a
f (ContentLine SourcePos
_ CI Text
_ [(CI Text, [Text])]
o ByteString
bs) = do
    URI
uri <- String -> ContentParser URI
parseURI (String -> ContentParser URI)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
-> ContentParser URI
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (DecodingFunctions -> String)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     String
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Text -> String
T.unpack (Text -> String)
-> (DecodingFunctions -> Text) -> DecodingFunctions -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString
bs) ((ByteString -> Text) -> Text)
-> (DecodingFunctions -> ByteString -> Text)
-> DecodingFunctions
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecodingFunctions -> ByteString -> Text
dfBS2Text)
    a -> ContentParser a
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ContentParser a)
-> (OtherParams -> a) -> OtherParams -> ContentParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> OtherParams -> a
f URI
uri (OtherParams -> ContentParser a) -> OtherParams -> ContentParser a
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o
parseSimpleURI URI -> OtherParams -> a
_ Content
x = String -> ContentParser a
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser a) -> String -> ContentParser a
forall a b. (a -> b) -> a -> b
$ String
"parseSimpleURI: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x


-- | Parse something which has either a 'Date' or a 'DateTime' value, and
-- 'OtherParams'. Uses DateTime if there is no value parameter.
parseSimpleDateOrDateTime :: (DateTime -> OtherParams -> a)
                          -> (Date     -> OtherParams -> a)
                          -> Content
                          -> ContentParser a
parseSimpleDateOrDateTime :: forall a.
(DateTime -> OtherParams -> a)
-> (Date -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDateOrDateTime DateTime -> OtherParams -> a
dt Date -> OtherParams -> a
d (ContentLine SourcePos
_ CI Text
_ [(CI Text, [Text])]
o ByteString
bs) = do
    (Text
typ, Maybe Text
tzid, [(CI Text, [Text])]
o') <- [(CI Text, [Text])]
-> ContentParser (Text, Maybe Text, [(CI Text, [Text])])
typTzIdO [(CI Text, [Text])]
o
    case Text
typ of
         Text
"DATE-TIME" -> do DateTime
x <- Maybe Text -> ByteString -> ContentParser DateTime
parseDateTime Maybe Text
tzid ByteString
bs
                           a -> ContentParser a
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ContentParser a)
-> (OtherParams -> a) -> OtherParams -> ContentParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DateTime -> OtherParams -> a
dt DateTime
x (OtherParams -> ContentParser a) -> OtherParams -> ContentParser a
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o'
         Text
"DATE" -> do Date
x <- ByteString -> ContentParser Date
parseDate ByteString
bs
                      a -> ContentParser a
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ContentParser a)
-> (OtherParams -> a) -> OtherParams -> ContentParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Date -> OtherParams -> a
d Date
x (OtherParams -> ContentParser a) -> OtherParams -> ContentParser a
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o'
         Text
_ -> String -> ContentParser a
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser a) -> String -> ContentParser a
forall a b. (a -> b) -> a -> b
$ String
"Invalid type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
typ
parseSimpleDateOrDateTime DateTime -> OtherParams -> a
_ Date -> OtherParams -> a
_ Content
x =
    String -> ContentParser a
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser a) -> String -> ContentParser a
forall a b. (a -> b) -> a -> b
$ String
"parseSimpleDateOrDateTime: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Parse something which has a set of either a 'Date' or a 'DateTime' value,
-- and 'OtherParams'. Uses DateTime if there is no value parameter.
parseSimpleDatesOrDateTimes :: (Set DateTime -> OtherParams -> a)
                            -> (Set Date     -> OtherParams -> a)
                            -> Content
                            -> ContentParser a
parseSimpleDatesOrDateTimes :: forall a.
(Set DateTime -> OtherParams -> a)
-> (Set Date -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDatesOrDateTimes Set DateTime -> OtherParams -> a
dt Set Date -> OtherParams -> a
d (ContentLine SourcePos
_ CI Text
_ [(CI Text, [Text])]
o ByteString
bs) = do
    (Text
typ, Maybe Text
tzid, [(CI Text, [Text])]
o') <- [(CI Text, [Text])]
-> ContentParser (Text, Maybe Text, [(CI Text, [Text])])
typTzIdO [(CI Text, [Text])]
o
    case Text
typ of
         Text
"DATE-TIME" -> do Set DateTime
x <- [DateTime] -> Set DateTime
forall a. Ord a => [a] -> Set a
S.fromList ([DateTime] -> Set DateTime)
-> ([ByteString]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         [DateTime])
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set DateTime)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (ByteString -> ContentParser DateTime)
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [DateTime]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Maybe Text -> ByteString -> ContentParser DateTime
parseDateTime Maybe Text
tzid) ([ByteString]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Set DateTime))
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set DateTime)
forall a b. (a -> b) -> a -> b
$
                                                Char -> ByteString -> [ByteString]
B.split Char
',' ByteString
bs
                           a -> ContentParser a
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ContentParser a)
-> (OtherParams -> a) -> OtherParams -> ContentParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set DateTime -> OtherParams -> a
dt Set DateTime
x (OtherParams -> ContentParser a) -> OtherParams -> ContentParser a
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o'
         Text
"DATE" -> do Set Date
x <- [Date] -> Set Date
forall a. Ord a => [a] -> Set a
S.fromList ([Date] -> Set Date)
-> ([ByteString]
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         [Date])
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set Date)
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: (ByteString -> ContentParser Date)
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Date]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ByteString -> ContentParser Date
parseDate ([ByteString]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Set Date))
-> [ByteString]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Set Date)
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
B.split Char
',' ByteString
bs
                      a -> ContentParser a
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ContentParser a)
-> (OtherParams -> a) -> OtherParams -> ContentParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Date -> OtherParams -> a
d Set Date
x (OtherParams -> ContentParser a) -> OtherParams -> ContentParser a
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o'
         Text
_ -> String -> ContentParser a
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser a) -> String -> ContentParser a
forall a b. (a -> b) -> a -> b
$ String
"Invalid type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
typ
parseSimpleDatesOrDateTimes Set DateTime -> OtherParams -> a
_ Set Date -> OtherParams -> a
_ Content
x =
    String -> ContentParser a
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser a) -> String -> ContentParser a
forall a b. (a -> b) -> a -> b
$ String
"parseSimpleDatesOrDateTimes: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

typTzIdO :: [(CI Text, [Text])]
         -> ContentParser (Text, Maybe Text, [(CI Text, [Text])])
typTzIdO :: [(CI Text, [Text])]
-> ContentParser (Text, Maybe Text, [(CI Text, [Text])])
typTzIdO [(CI Text, [Text])]
o = do
    Text
typ <- [Text] -> ContentParser Text
forall a. [a] -> ContentParser a
paramOnlyOne ([Text] -> ContentParser Text)
-> (Maybe [Text] -> [Text]) -> Maybe [Text] -> ContentParser Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [Text
"DATE-TIME"] (Maybe [Text] -> ContentParser Text)
-> Maybe [Text] -> ContentParser Text
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"VALUE" [(CI Text, [Text])]
o
    Maybe Text
tzid <- ([Text] -> ContentParser Text)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Text] -> ContentParser Text
forall a. [a] -> ContentParser a
paramOnlyOne (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Text))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ if Text
typ Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"DATE-TIME" then CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"TZID" [(CI Text, [Text])]
o
                                                      else Maybe [Text]
forall a. Maybe a
Nothing
    let f :: a -> Bool
f a
x = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
"VALUE" Bool -> Bool -> Bool
&& (Text
typ Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"DATE-TIME" Bool -> Bool -> Bool
|| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
"TZID")
        o' :: [(CI Text, [Text])]
o' = ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (CI Text -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
f (CI Text -> Bool)
-> ((CI Text, [Text]) -> CI Text) -> (CI Text, [Text]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI Text, [Text]) -> CI Text
forall a b. (a, b) -> a
fst) [(CI Text, [Text])]
o
    (Text, Maybe Text, [(CI Text, [Text])])
-> ContentParser (Text, Maybe Text, [(CI Text, [Text])])
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
typ, Maybe Text
tzid, [(CI Text, [Text])]
o')

-- | Parse something which has only a DateTime value, and 'OtherParams'.
parseSimpleDateTime :: (DateTime -> OtherParams -> a)
                    -> Content
                    -> ContentParser a
parseSimpleDateTime :: forall a.
(DateTime -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleDateTime DateTime -> OtherParams -> a
dt (ContentLine SourcePos
_ CI Text
_ [(CI Text, [Text])]
o ByteString
bs) = do
    Maybe Text
tzid <- ([Text] -> ContentParser Text)
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM [Text] -> ContentParser Text
forall a. [a] -> ContentParser a
paramOnlyOne (Maybe [Text]
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      (Maybe Text))
-> Maybe [Text]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (Maybe Text)
forall a b. (a -> b) -> a -> b
$ CI Text -> [(CI Text, [Text])] -> Maybe [Text]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI Text
"TZID" [(CI Text, [Text])]
o
    let o' :: [(CI Text, [Text])]
o' = ((CI Text, [Text]) -> Bool)
-> [(CI Text, [Text])] -> [(CI Text, [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((CI Text -> CI Text -> Bool
forall a. Eq a => a -> a -> Bool
/=CI Text
"TZID") (CI Text -> Bool)
-> ((CI Text, [Text]) -> CI Text) -> (CI Text, [Text]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CI Text, [Text]) -> CI Text
forall a b. (a, b) -> a
fst) [(CI Text, [Text])]
o
    (DateTime -> OtherParams -> a) -> OtherParams -> DateTime -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip DateTime -> OtherParams -> a
dt ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o') (DateTime -> a) -> ContentParser DateTime -> ContentParser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> ByteString -> ContentParser DateTime
parseDateTime Maybe Text
tzid ByteString
bs
parseSimpleDateTime DateTime -> OtherParams -> a
_ Content
x = String -> ContentParser a
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser a) -> String -> ContentParser a
forall a b. (a -> b) -> a -> b
$ String
"parseSimpleDateTime: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

parseSimpleUTC :: (UTCTime -> OtherParams -> a)
               -> Content
               -> ContentParser a
parseSimpleUTC :: forall a.
(UTCTime -> OtherParams -> a) -> Content -> ContentParser a
parseSimpleUTC UTCTime -> OtherParams -> a
dt (ContentLine SourcePos
_ CI Text
_ [(CI Text, [Text])]
o ByteString
bs) =
    (UTCTime -> OtherParams -> a) -> OtherParams -> UTCTime -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip UTCTime -> OtherParams -> a
dt ([(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
o) (UTCTime -> a)
-> ContentParser UTCTime
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (DateTime -> ContentParser UTCTime
mustBeUTC (DateTime -> ContentParser UTCTime)
-> ContentParser DateTime -> ContentParser UTCTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text -> ByteString -> ContentParser DateTime
parseDateTime Maybe Text
forall a. Maybe a
Nothing ByteString
bs)
parseSimpleUTC UTCTime -> OtherParams -> a
_ Content
x = String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) a)
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall a b. (a -> b) -> a -> b
$ String
"parseSimpleUTC: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
x

-- | Convert a property dictionary to 'OtherParams'.
toO :: [(CI Text, [Text])] -> OtherParams
toO :: [(CI Text, [Text])] -> OtherParams
toO = Set OtherParam -> OtherParams
OtherParams (Set OtherParam -> OtherParams)
-> ([(CI Text, [Text])] -> Set OtherParam)
-> [(CI Text, [Text])]
-> OtherParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OtherParam] -> Set OtherParam
forall a. Ord a => [a] -> Set a
S.fromList ([OtherParam] -> Set OtherParam)
-> ([(CI Text, [Text])] -> [OtherParam])
-> [(CI Text, [Text])]
-> Set OtherParam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CI Text, [Text]) -> OtherParam)
-> [(CI Text, [Text])] -> [OtherParam]
forall a b. (a -> b) -> [a] -> [b]
map ((CI Text -> [Text] -> OtherParam)
-> (CI Text, [Text]) -> OtherParam
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CI Text -> [Text] -> OtherParam
OtherParam)

-- | Get the remaining properties.
otherProperties :: ContentParser (Set OtherProperty)
otherProperties :: ContentParser (Set OtherProperty)
otherProperties = do [Content]
opts <- (SourcePos, [Content]) -> [Content]
forall a b. (a, b) -> b
snd ((SourcePos, [Content]) -> [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (SourcePos, [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (SourcePos, [Content])
forall s (m :: * -> *). MonadState s m => m s
get
                     ((SourcePos, [Content]) -> (SourcePos, [Content]))
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Content] -> [Content])
-> (SourcePos, [Content]) -> (SourcePos, [Content])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Content] -> [Content])
 -> (SourcePos, [Content]) -> (SourcePos, [Content]))
-> ([Content] -> [Content])
-> (SourcePos, [Content])
-> (SourcePos, [Content])
forall a b. (a -> b) -> a -> b
$ [Content] -> [Content] -> [Content]
forall a b. a -> b -> a
const [])
                     [OtherProperty] -> Set OtherProperty
forall a. Ord a => [a] -> Set a
S.fromList ([OtherProperty] -> Set OtherProperty)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [OtherProperty]
-> ContentParser (Set OtherProperty)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      OtherProperty)
-> [Content]
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [OtherProperty]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     OtherProperty
lineToOtherProp [Content]
opts
  where lineToOtherProp :: Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     OtherProperty
lineToOtherProp (ContentLine SourcePos
_ CI Text
n [(CI Text, [Text])]
opts ByteString
bs) =
            OtherProperty
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     OtherProperty
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return (CI Text -> ByteString -> OtherParams -> OtherProperty
OtherProperty CI Text
n ByteString
bs (OtherParams -> OtherProperty) -> OtherParams -> OtherProperty
forall a b. (a -> b) -> a -> b
$ [(CI Text, [Text])] -> OtherParams
toO [(CI Text, [Text])]
opts)
        lineToOtherProp c :: Content
c@Component {} =
            Content
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     OtherProperty
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     OtherProperty
forall a. Content -> ContentParser a -> ContentParser a
down Content
c (ExceptT
   String
   (RWS DecodingFunctions [String] (SourcePos, [Content]))
   OtherProperty
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      OtherProperty)
-> (String
    -> ExceptT
         String
         (RWS DecodingFunctions [String] (SourcePos, [Content]))
         OtherProperty)
-> String
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     OtherProperty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     OtherProperty
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
 -> ExceptT
      String
      (RWS DecodingFunctions [String] (SourcePos, [Content]))
      OtherProperty)
-> String
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     OtherProperty
forall a b. (a -> b) -> a -> b
$ String
"Unconsumed component: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Content -> String
forall a. Show a => a -> String
show Content
c

neg :: TextParser (Int -> Int)
neg :: TextParser (Int -> Int)
neg = (Int -> Int) -> (Char -> Int -> Int) -> Maybe Char -> Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int -> Int
forall a. a -> a
id (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' then Int -> Int
forall a. Num a => a -> a
negate else Int -> Int
forall a. a -> a
id)
            (Maybe Char -> Int -> Int)
-> ParsecT ByteString DecodingFunctions Identity (Maybe Char)
-> TextParser (Int -> Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString DecodingFunctions Identity Char
-> ParsecT ByteString DecodingFunctions Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> ParsecT ByteString DecodingFunctions Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
P.oneOf String
"+-")

digits :: TextParser Int
digits :: TextParser Int
digits = (Int -> Int -> Int) -> [Int] -> Int
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (Int -> Int -> Int
forall a. Num a => a -> a -> a
(+)(Int -> Int -> Int) -> (Int -> Int) -> Int -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
10)) ([Int] -> Int) -> (String -> [Int]) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
digitToInt (String -> Int)
-> ParsecT ByteString DecodingFunctions Identity String
-> TextParser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT ByteString DecodingFunctions Identity Char
-> ParsecT ByteString DecodingFunctions Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT ByteString DecodingFunctions Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
P.digit

digitsN :: TextParser [Int]
digitsN :: TextParser [Int]
digitsN = TextParser Int
-> ParsecT ByteString DecodingFunctions Identity Char
-> TextParser [Int]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 TextParser Int
digits (Char -> ParsecT ByteString DecodingFunctions Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
P.char Char
',')

-- }}}

-- | Set the parser context.
down :: Content -> ContentParser a -> ContentParser a
down :: forall a. Content -> ContentParser a -> ContentParser a
down (Component SourcePos
p CI Text
_ [Content]
x) = (SourcePos, [Content]) -> ContentParser a -> ContentParser a
forall a.
(SourcePos, [Content]) -> ContentParser a -> ContentParser a
down' (SourcePos
p, [Content]
x)
down x :: Content
x@(ContentLine SourcePos
p CI Text
_ [(CI Text, [Text])]
_ ByteString
_) = (SourcePos, [Content]) -> ContentParser a -> ContentParser a
forall a.
(SourcePos, [Content]) -> ContentParser a -> ContentParser a
down' (SourcePos
p, [Content
x])

-- | Set the parser context.
down' :: (P.SourcePos, [Content]) -> ContentParser a -> ContentParser a
down' :: forall a.
(SourcePos, [Content]) -> ContentParser a -> ContentParser a
down' (SourcePos, [Content])
x ContentParser a
m = ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (SourcePos, [Content])
forall s (m :: * -> *). MonadState s m => m s
get ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (SourcePos, [Content])
-> ((SourcePos, [Content]) -> ContentParser a) -> ContentParser a
forall a b.
ExceptT
  String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
-> (a
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) b)
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(SourcePos, [Content])
old -> (SourcePos, [Content])
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SourcePos, [Content])
x ExceptT
  String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ContentParser a -> ContentParser a
forall a b.
ExceptT
  String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) b
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ContentParser a
m ContentParser a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ContentParser a
forall a b.
ExceptT
  String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) b
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (SourcePos, [Content])
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (SourcePos, [Content])
old

-- | Many optional components named ...
optCompN :: Ord a
         => CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optCompN :: forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optCompN CI Text
s Content -> ContentParser a
f = (Content -> ContentParser a)
-> ([Content], [Content]) -> ContentParser (Set a)
forall b.
Ord b =>
(Content -> ContentParser b)
-> ([Content], [Content]) -> ContentParser (Set b)
optN Content -> ContentParser a
f (([Content], [Content]) -> ContentParser (Set a))
-> ([Content] -> ([Content], [Content]))
-> [Content]
-> ContentParser (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Bool) -> [Content] -> ([Content], [Content])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Content -> CI Text -> Bool
`isComponentNamed` CI Text
s) ([Content] -> ContentParser (Set a))
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
-> ContentParser (Set a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SourcePos, [Content]) -> [Content]
forall a b. (a, b) -> b
snd ((SourcePos, [Content]) -> [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (SourcePos, [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (SourcePos, [Content])
forall s (m :: * -> *). MonadState s m => m s
get

-- | One required line named ...
reqLine1 :: CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 :: forall a.
CI Text -> (Content -> ContentParser a) -> ContentParser a
reqLine1 CI Text
s Content -> ContentParser a
f = CI Text
-> (Content -> ContentParser a)
-> ([Content], [Content])
-> ContentParser a
forall b.
CI Text
-> (Content -> ContentParser b)
-> ([Content], [Content])
-> ContentParser b
req1 CI Text
s Content -> ContentParser a
f (([Content], [Content]) -> ContentParser a)
-> ([Content] -> ([Content], [Content]))
-> [Content]
-> ContentParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Bool) -> [Content] -> ([Content], [Content])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Content -> CI Text -> Bool
`isLineNamed` CI Text
s) ([Content] -> ContentParser a)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
-> ContentParser a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SourcePos, [Content]) -> [Content]
forall a b. (a, b) -> b
snd ((SourcePos, [Content]) -> [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (SourcePos, [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (SourcePos, [Content])
forall s (m :: * -> *). MonadState s m => m s
get

-- | One optional line named ...
optLine1 :: Default b
         => CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 :: forall b.
Default b =>
CI Text -> (Content -> ContentParser b) -> ContentParser b
optLine1 CI Text
s Content -> ContentParser b
f = (Content -> ContentParser b)
-> ([Content], [Content]) -> ContentParser b
forall b.
Default b =>
(Content -> ContentParser b)
-> ([Content], [Content]) -> ContentParser b
opt1 Content -> ContentParser b
f (([Content], [Content]) -> ContentParser b)
-> ([Content] -> ([Content], [Content]))
-> [Content]
-> ContentParser b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Bool) -> [Content] -> ([Content], [Content])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Content -> CI Text -> Bool
`isLineNamed` CI Text
s) ([Content] -> ContentParser b)
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
-> ContentParser b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SourcePos, [Content]) -> [Content]
forall a b. (a, b) -> b
snd ((SourcePos, [Content]) -> [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (SourcePos, [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (SourcePos, [Content])
forall s (m :: * -> *). MonadState s m => m s
get

-- | Many optional lines named ...
optLineN :: Ord b
         => CI Text -> (Content -> ContentParser b) -> ContentParser (Set b)
optLineN :: forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
optLineN CI Text
s Content -> ContentParser b
f = (Content -> ContentParser b)
-> ([Content], [Content]) -> ContentParser (Set b)
forall b.
Ord b =>
(Content -> ContentParser b)
-> ([Content], [Content]) -> ContentParser (Set b)
optN Content -> ContentParser b
f (([Content], [Content]) -> ContentParser (Set b))
-> ([Content] -> ([Content], [Content]))
-> [Content]
-> ContentParser (Set b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Bool) -> [Content] -> ([Content], [Content])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Content -> CI Text -> Bool
`isLineNamed` CI Text
s) ([Content] -> ContentParser (Set b))
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
-> ContentParser (Set b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SourcePos, [Content]) -> [Content]
forall a b. (a, b) -> b
snd ((SourcePos, [Content]) -> [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (SourcePos, [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (SourcePos, [Content])
forall s (m :: * -> *). MonadState s m => m s
get

-- | Many lines named ..., at least one required.
reqLineN :: Ord b
         => CI Text -> (Content -> ContentParser b) -> ContentParser (Set b)
reqLineN :: forall a.
Ord a =>
CI Text -> (Content -> ContentParser a) -> ContentParser (Set a)
reqLineN CI Text
s Content -> ContentParser b
f = CI Text
-> (Content -> ContentParser b)
-> ([Content], [Content])
-> ContentParser (Set b)
forall b.
Ord b =>
CI Text
-> (Content -> ContentParser b)
-> ([Content], [Content])
-> ContentParser (Set b)
reqN CI Text
s Content -> ContentParser b
f (([Content], [Content]) -> ContentParser (Set b))
-> ([Content] -> ([Content], [Content]))
-> [Content]
-> ContentParser (Set b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Content -> Bool) -> [Content] -> ([Content], [Content])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Content -> CI Text -> Bool
`isLineNamed` CI Text
s) ([Content] -> ContentParser (Set b))
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
-> ContentParser (Set b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (SourcePos, [Content]) -> [Content]
forall a b. (a, b) -> b
snd ((SourcePos, [Content]) -> [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     (SourcePos, [Content])
-> ExceptT
     String
     (RWS DecodingFunctions [String] (SourcePos, [Content]))
     [Content]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  String
  (RWS DecodingFunctions [String] (SourcePos, [Content]))
  (SourcePos, [Content])
forall s (m :: * -> *). MonadState s m => m s
get

-- | One required ...
req1 :: CI Text -> (Content -> ContentParser b) -> ([Content], [Content])
     -> ContentParser b
req1 :: forall b.
CI Text
-> (Content -> ContentParser b)
-> ([Content], [Content])
-> ContentParser b
req1 CI Text
_ Content -> ContentParser b
f ([Content
x], [Content]
xs) = ((SourcePos, [Content]) -> (SourcePos, [Content]))
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Content] -> [Content])
-> (SourcePos, [Content]) -> (SourcePos, [Content])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Content] -> [Content])
 -> (SourcePos, [Content]) -> (SourcePos, [Content]))
-> ([Content] -> [Content])
-> (SourcePos, [Content])
-> (SourcePos, [Content])
forall a b. (a -> b) -> a -> b
$ [Content] -> [Content] -> [Content]
forall a b. a -> b -> a
const [Content]
xs) ExceptT
  String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ContentParser b -> ContentParser b
forall a b.
ExceptT
  String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) b
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Content -> ContentParser b -> ContentParser b
forall a. Content -> ContentParser a -> ContentParser a
down Content
x (Content -> ContentParser b
f Content
x)
req1 CI Text
s Content -> ContentParser b
_ ([], [Content]
_) = String -> ContentParser b
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ContentParser b) -> String -> ContentParser b
forall a b. (a -> b) -> a -> b
$ String
"Missing content: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CI Text -> String
forall a. Show a => a -> String
show CI Text
s
req1 CI Text
_ Content -> ContentParser b
f (Content
x:[Content]
xs, [Content]
xs') = do ((SourcePos, [Content]) -> (SourcePos, [Content]))
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Content] -> [Content])
-> (SourcePos, [Content]) -> (SourcePos, [Content])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Content] -> [Content])
 -> (SourcePos, [Content]) -> (SourcePos, [Content]))
-> ([Content] -> [Content])
-> (SourcePos, [Content])
-> (SourcePos, [Content])
forall a b. (a -> b) -> a -> b
$ [Content] -> [Content] -> [Content]
forall a b. a -> b -> a
const [Content]
xs')
                          [String]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ((Content -> String) -> [Content] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"Extra content: " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Content -> String) -> Content -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> String
forall a. Show a => a -> String
show) [Content]
xs)
                          Content -> ContentParser b -> ContentParser b
forall a. Content -> ContentParser a -> ContentParser a
down Content
x (ContentParser b -> ContentParser b)
-> ContentParser b -> ContentParser b
forall a b. (a -> b) -> a -> b
$ Content -> ContentParser b
f Content
x

-- | One optional ...
opt1 :: Default b
     => (Content -> ContentParser b) -> ([Content], [Content])
     -> ContentParser b
opt1 :: forall b.
Default b =>
(Content -> ContentParser b)
-> ([Content], [Content]) -> ContentParser b
opt1 Content -> ContentParser b
f ([Content
x], [Content]
xs) = ((SourcePos, [Content]) -> (SourcePos, [Content]))
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Content] -> [Content])
-> (SourcePos, [Content]) -> (SourcePos, [Content])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Content] -> [Content])
 -> (SourcePos, [Content]) -> (SourcePos, [Content]))
-> ([Content] -> [Content])
-> (SourcePos, [Content])
-> (SourcePos, [Content])
forall a b. (a -> b) -> a -> b
$ [Content] -> [Content] -> [Content]
forall a b. a -> b -> a
const [Content]
xs) ExceptT
  String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ContentParser b -> ContentParser b
forall a b.
ExceptT
  String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) b
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Content -> ContentParser b -> ContentParser b
forall a. Content -> ContentParser a -> ContentParser a
down Content
x (Content -> ContentParser b
f Content
x)
opt1 Content -> ContentParser b
_ ([], [Content]
_) = b -> ContentParser b
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return b
forall a. Default a => a
def
opt1 Content -> ContentParser b
f (Content
x:[Content]
xs, [Content]
xs') = do ((SourcePos, [Content]) -> (SourcePos, [Content]))
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Content] -> [Content])
-> (SourcePos, [Content]) -> (SourcePos, [Content])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Content] -> [Content])
 -> (SourcePos, [Content]) -> (SourcePos, [Content]))
-> ([Content] -> [Content])
-> (SourcePos, [Content])
-> (SourcePos, [Content])
forall a b. (a -> b) -> a -> b
$ [Content] -> [Content] -> [Content]
forall a b. a -> b -> a
const [Content]
xs')
                        [String]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ((Content -> String) -> [Content] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
"Extra content: " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (Content -> String) -> Content -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> String
forall a. Show a => a -> String
show) [Content]
xs)
                        Content -> ContentParser b -> ContentParser b
forall a. Content -> ContentParser a -> ContentParser a
down Content
x (ContentParser b -> ContentParser b)
-> ContentParser b -> ContentParser b
forall a b. (a -> b) -> a -> b
$ Content -> ContentParser b
f Content
x

-- | Many optional ...
optN :: Ord b
     => (Content -> ContentParser b) -> ([Content], [Content])
     -> ContentParser (Set b)
optN :: forall b.
Ord b =>
(Content -> ContentParser b)
-> ([Content], [Content]) -> ContentParser (Set b)
optN Content -> ContentParser b
f ([Content]
xs, [Content]
xs') = do ((SourcePos, [Content]) -> (SourcePos, [Content]))
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Content] -> [Content])
-> (SourcePos, [Content]) -> (SourcePos, [Content])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Content] -> [Content])
 -> (SourcePos, [Content]) -> (SourcePos, [Content]))
-> ([Content] -> [Content])
-> (SourcePos, [Content])
-> (SourcePos, [Content])
forall a b. (a -> b) -> a -> b
$ [Content] -> [Content] -> [Content]
forall a b. a -> b -> a
const [Content]
xs')
                      [b] -> Set b
forall a. Ord a => [a] -> Set a
S.fromList ([b] -> Set b)
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) [b]
-> ContentParser (Set b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> ContentParser b)
-> [Content]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Content
x -> Content -> ContentParser b -> ContentParser b
forall a. Content -> ContentParser a -> ContentParser a
down Content
x (Content -> ContentParser b
f Content
x)) [Content]
xs

-- | Many ..., at least one required.
reqN :: Ord b
     => CI Text -- ^ What, needed for the error.
     -> (Content -> ContentParser b) -> ([Content], [Content])
     -> ContentParser (Set b)
reqN :: forall b.
Ord b =>
CI Text
-> (Content -> ContentParser b)
-> ([Content], [Content])
-> ContentParser (Set b)
reqN CI Text
w Content -> ContentParser b
f ([Content]
xs, [Content]
xs') = do ((SourcePos, [Content]) -> (SourcePos, [Content]))
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Content] -> [Content])
-> (SourcePos, [Content]) -> (SourcePos, [Content])
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (([Content] -> [Content])
 -> (SourcePos, [Content]) -> (SourcePos, [Content]))
-> ([Content] -> [Content])
-> (SourcePos, [Content])
-> (SourcePos, [Content])
forall a b. (a -> b) -> a -> b
$ [Content] -> [Content] -> [Content]
forall a b. a -> b -> a
const [Content]
xs')
                        Set b
o <- [b] -> Set b
forall a. Ord a => [a] -> Set a
S.fromList ([b] -> Set b)
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) [b]
-> ContentParser (Set b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Content -> ContentParser b)
-> [Content]
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\Content
x -> Content -> ContentParser b -> ContentParser b
forall a. Content -> ContentParser a -> ContentParser a
down Content
x (Content -> ContentParser b
f Content
x)) [Content]
xs
                        Bool
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Set b -> Int
forall a. Set a -> Int
S.size Set b
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1) (ExceptT
   String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> (String
    -> ExceptT
         String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                            String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String
 -> ExceptT
      String (RWS DecodingFunctions [String] (SourcePos, [Content])) ())
-> String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) ()
forall a b. (a -> b) -> a -> b
$ String
"At least one required: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CI Text -> String
forall a. Show a => a -> String
show CI Text
w
                        Set b -> ContentParser (Set b)
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return Set b
o

-- | Only allow one parameter value.
paramOnlyOne :: [a] -> ContentParser a
paramOnlyOne :: forall a. [a] -> ContentParser a
paramOnlyOne [a
x] = a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
paramOnlyOne [a]
_ = String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Only one parameter value allowed."

valueOnlyOne :: [a] -> ContentParser a
valueOnlyOne :: forall a. [a] -> ContentParser a
valueOnlyOne [a
x] = a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall a.
a
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
valueOnlyOne [] = String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Must have one value, not zero."
valueOnlyOne [a]
_ = String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall a.
String
-> ExceptT
     String (RWS DecodingFunctions [String] (SourcePos, [Content])) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Only one value allowed."

-- | Line predicate.
isLineNamed :: Content -> CI Text -> Bool
isLineNamed :: Content -> CI Text -> Bool
isLineNamed (ContentLine SourcePos
_ CI Text
n [(CI Text, [Text])]
_ ByteString
_) CI Text
n' | CI Text
n CI Text -> CI Text -> Bool
forall a. Eq a => a -> a -> Bool
== CI Text
n' = Bool
True
isLineNamed Content
_ CI Text
_ = Bool
False

-- | Component name predicate.
isComponentNamed :: Content -> CI Text -> Bool
isComponentNamed :: Content -> CI Text -> Bool
isComponentNamed (Component SourcePos
_ CI Text
n [Content]
_) CI Text
n' | CI Text
n CI Text -> CI Text -> Bool
forall a. Eq a => a -> a -> Bool
== CI Text
n' = Bool
True
isComponentNamed Content
_ CI Text
_ = Bool
False

isComponent :: Content -> Bool
isComponent :: Content -> Bool
isComponent Component {} = Bool
True
isComponent Content
_ = Bool
False

-- Util

maybeRead :: Read a => String -> Maybe a
maybeRead :: forall a. Read a => String -> Maybe a
maybeRead = (a, String) -> a
forall a b. (a, b) -> a
fst ((a, String) -> a)
-> (String -> Maybe (a, String)) -> String -> Maybe a
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
.: [(a, String)] -> Maybe (a, String)
forall a. [a] -> Maybe a
lastToMaybe ([(a, String)] -> Maybe (a, String))
-> (String -> [(a, String)]) -> String -> Maybe (a, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(a, String)]
forall a. Read a => ReadS a
reads

lastToMaybe :: [a] -> Maybe a
lastToMaybe :: forall a. [a] -> Maybe a
lastToMaybe [a]
x = if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
x then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ [a] -> a
forall a. HasCallStack => [a] -> a
last [a]
x

(.:) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
.: :: forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
(.:) = ((g a -> g b) -> f (g a) -> f (g b))
-> ((a -> b) -> g a -> g b) -> (a -> b) -> f (g a) -> f (g b)
forall a b. (a -> b) -> ((a -> b) -> a) -> (a -> b) -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (g a -> g b) -> f (g a) -> f (g b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b) -> g a -> g b
forall a b. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

infixl 4 .: