{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Text.ICalendar.Parser
    ( parseICalendar
    , parseICalendarFile
    , parseICal
    , parseICalFile
    , DecodingFunctions(..)
    ) where

import           Control.Applicative
import           Control.Monad
import           Control.Monad.Except
import           Control.Monad.RWS          (runRWS)
import           Data.ByteString.Lazy       (ByteString)
import qualified Data.ByteString.Lazy.Char8 as B
import           Data.Monoid
import           Prelude

import Text.Parsec.ByteString.Lazy ()
import Text.Parsec.Pos
import Text.Parsec.Prim            hiding (many, (<|>))
import Text.Parsec.Text.Lazy       ()

import Text.ICalendar.Parser.Common
import Text.ICalendar.Parser.Components
import Text.ICalendar.Parser.Content
import Text.ICalendar.Types


-- | Parse a ByteString containing iCalendar data.
--
-- Returns either an error, or a tuple of the result and a list of warnings.
parseICalendar :: DecodingFunctions
               -> FilePath -- ^ Used in error messages.
               -> ByteString
               -> Either String ([VCalendar], [String])
parseICalendar :: DecodingFunctions
-> String -> ByteString -> Either String ([VCalendar], [String])
parseICalendar DecodingFunctions
s String
f ByteString
bs = do
    [Content]
a <- (ParseError -> Either String [Content])
-> ([Content] -> Either String [Content])
-> Either ParseError [Content]
-> Either String [Content]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Either String [Content]
forall a b. a -> Either a b
Left (String -> Either String [Content])
-> (ParseError -> String) -> ParseError -> Either String [Content]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) [Content] -> Either String [Content]
forall a b. b -> Either a b
Right (Either ParseError [Content] -> Either String [Content])
-> Either ParseError [Content] -> Either String [Content]
forall a b. (a -> b) -> a -> b
$ Parsec ByteString DecodingFunctions [Content]
-> DecodingFunctions
-> String
-> ByteString
-> Either ParseError [Content]
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser Parsec ByteString DecodingFunctions [Content]
parseToContent DecodingFunctions
s String
f ByteString
bs
    Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Content] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Content]
a) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
"Missing content."
    let xs :: [(Either String VCalendar, (SourcePos, [Content]), [String])]
xs = (Content
 -> (Either String VCalendar, (SourcePos, [Content]), [String]))
-> [Content]
-> [(Either String VCalendar, (SourcePos, [Content]), [String])]
forall a b. (a -> b) -> [a] -> [b]
map (DecodingFunctions
-> ContentParser VCalendar
-> (Either String VCalendar, (SourcePos, [Content]), [String])
forall a.
DecodingFunctions
-> ContentParser a
-> (Either String a, (SourcePos, [Content]), [String])
runCP DecodingFunctions
s (ContentParser VCalendar
 -> (Either String VCalendar, (SourcePos, [Content]), [String]))
-> (Content -> ContentParser VCalendar)
-> Content
-> (Either String VCalendar, (SourcePos, [Content]), [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Content -> ContentParser VCalendar
parseVCalendar) [Content]
a
    ([VCalendar]
x, [String]
w) <- ((((([VCalendar], [String])
  -> (Either String VCalendar, (SourcePos, [Content]), [String])
  -> Either String ([VCalendar], [String]))
 -> [(Either String VCalendar, (SourcePos, [Content]), [String])]
 -> Either String ([VCalendar], [String]))
-> [(Either String VCalendar, (SourcePos, [Content]), [String])]
-> (([VCalendar], [String])
    -> (Either String VCalendar, (SourcePos, [Content]), [String])
    -> Either String ([VCalendar], [String]))
-> Either String ([VCalendar], [String])
forall a b c. (a -> b -> c) -> b -> a -> c
flip(((([VCalendar], [String])
   -> (Either String VCalendar, (SourcePos, [Content]), [String])
   -> Either String ([VCalendar], [String]))
  -> [(Either String VCalendar, (SourcePos, [Content]), [String])]
  -> Either String ([VCalendar], [String]))
 -> [(Either String VCalendar, (SourcePos, [Content]), [String])]
 -> (([VCalendar], [String])
     -> (Either String VCalendar, (SourcePos, [Content]), [String])
     -> Either String ([VCalendar], [String]))
 -> Either String ([VCalendar], [String]))
-> (([VCalendar], [String])
    -> (([VCalendar], [String])
        -> (Either String VCalendar, (SourcePos, [Content]), [String])
        -> Either String ([VCalendar], [String]))
    -> [(Either String VCalendar, (SourcePos, [Content]), [String])]
    -> Either String ([VCalendar], [String]))
-> ([VCalendar], [String])
-> [(Either String VCalendar, (SourcePos, [Content]), [String])]
-> (([VCalendar], [String])
    -> (Either String VCalendar, (SourcePos, [Content]), [String])
    -> Either String ([VCalendar], [String]))
-> Either String ([VCalendar], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)((([VCalendar], [String])
  -> (([VCalendar], [String])
      -> (Either String VCalendar, (SourcePos, [Content]), [String])
      -> Either String ([VCalendar], [String]))
  -> [(Either String VCalendar, (SourcePos, [Content]), [String])]
  -> Either String ([VCalendar], [String]))
 -> ([VCalendar], [String])
 -> [(Either String VCalendar, (SourcePos, [Content]), [String])]
 -> (([VCalendar], [String])
     -> (Either String VCalendar, (SourcePos, [Content]), [String])
     -> Either String ([VCalendar], [String]))
 -> Either String ([VCalendar], [String]))
-> (((([VCalendar], [String])
      -> (Either String VCalendar, (SourcePos, [Content]), [String])
      -> Either String ([VCalendar], [String]))
     -> ([VCalendar], [String])
     -> [(Either String VCalendar, (SourcePos, [Content]), [String])]
     -> Either String ([VCalendar], [String]))
    -> ([VCalendar], [String])
    -> (([VCalendar], [String])
        -> (Either String VCalendar, (SourcePos, [Content]), [String])
        -> Either String ([VCalendar], [String]))
    -> [(Either String VCalendar, (SourcePos, [Content]), [String])]
    -> Either String ([VCalendar], [String]))
-> ((([VCalendar], [String])
     -> (Either String VCalendar, (SourcePos, [Content]), [String])
     -> Either String ([VCalendar], [String]))
    -> ([VCalendar], [String])
    -> [(Either String VCalendar, (SourcePos, [Content]), [String])]
    -> Either String ([VCalendar], [String]))
-> ([VCalendar], [String])
-> [(Either String VCalendar, (SourcePos, [Content]), [String])]
-> (([VCalendar], [String])
    -> (Either String VCalendar, (SourcePos, [Content]), [String])
    -> Either String ([VCalendar], [String]))
-> Either String ([VCalendar], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((([VCalendar], [String])
  -> (Either String VCalendar, (SourcePos, [Content]), [String])
  -> Either String ([VCalendar], [String]))
 -> ([VCalendar], [String])
 -> [(Either String VCalendar, (SourcePos, [Content]), [String])]
 -> Either String ([VCalendar], [String]))
-> ([VCalendar], [String])
-> (([VCalendar], [String])
    -> (Either String VCalendar, (SourcePos, [Content]), [String])
    -> Either String ([VCalendar], [String]))
-> [(Either String VCalendar, (SourcePos, [Content]), [String])]
-> Either String ([VCalendar], [String])
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([VCalendar], [String])
 -> (Either String VCalendar, (SourcePos, [Content]), [String])
 -> Either String ([VCalendar], [String]))
-> ([VCalendar], [String])
-> [(Either String VCalendar, (SourcePos, [Content]), [String])]
-> Either String ([VCalendar], [String])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([], []) [(Either String VCalendar, (SourcePos, [Content]), [String])]
xs ((([VCalendar], [String])
  -> (Either String VCalendar, (SourcePos, [Content]), [String])
  -> Either String ([VCalendar], [String]))
 -> Either String ([VCalendar], [String]))
-> (([VCalendar], [String])
    -> (Either String VCalendar, (SourcePos, [Content]), [String])
    -> Either String ([VCalendar], [String]))
-> Either String ([VCalendar], [String])
forall a b. (a -> b) -> a -> b
$ \([VCalendar]
x, [String]
ws) (Either String VCalendar
g, (SourcePos
pos, [Content]
_), [String]
w) ->
             case Either String VCalendar
g of
                  Left String
e -> String -> Either String ([VCalendar], [String])
forall a b. a -> Either a b
Left (String -> Either String ([VCalendar], [String]))
-> String -> Either String ([VCalendar], [String])
forall a b. (a -> b) -> a -> b
$ SourcePos -> String
forall a. Show a => a -> String
show SourcePos
pos String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e
                  Right VCalendar
y -> ([VCalendar], [String]) -> Either String ([VCalendar], [String])
forall a b. b -> Either a b
Right (VCalendar
yVCalendar -> [VCalendar] -> [VCalendar]
forall a. a -> [a] -> [a]
:[VCalendar]
x, [String]
w [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
ws)
    ([VCalendar], [String]) -> Either String ([VCalendar], [String])
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ([VCalendar]
x, [String]
w)

-- | Deprecated synonym for parseICalendar
parseICal :: DecodingFunctions
          -> FilePath
          -> ByteString
          -> Either String ([VCalendar], [String])
parseICal :: DecodingFunctions
-> String -> ByteString -> Either String ([VCalendar], [String])
parseICal = DecodingFunctions
-> String -> ByteString -> Either String ([VCalendar], [String])
parseICalendar
{-# DEPRECATED parseICal "Use parseICalendar instead" #-}

-- | Parse an iCalendar file.
parseICalendarFile :: DecodingFunctions
                   -> FilePath
                   -> IO (Either String ([VCalendar], [String]))
parseICalendarFile :: DecodingFunctions
-> String -> IO (Either String ([VCalendar], [String]))
parseICalendarFile DecodingFunctions
s String
f = DecodingFunctions
-> String -> ByteString -> Either String ([VCalendar], [String])
parseICal DecodingFunctions
s String
f (ByteString -> Either String ([VCalendar], [String]))
-> IO ByteString -> IO (Either String ([VCalendar], [String]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
f

-- | Deprecated synonym for parseICalendarFile
parseICalFile :: DecodingFunctions
              -> FilePath
              -> IO (Either String ([VCalendar], [String]))
parseICalFile :: DecodingFunctions
-> String -> IO (Either String ([VCalendar], [String]))
parseICalFile = DecodingFunctions
-> String -> IO (Either String ([VCalendar], [String]))
parseICalendarFile
{-# DEPRECATED parseICalFile "Use parseICalendarFile instead" #-}

runCP :: DecodingFunctions -> ContentParser a
      -> (Either String a, (SourcePos, [Content]), [String])
runCP :: forall a.
DecodingFunctions
-> ContentParser a
-> (Either String a, (SourcePos, [Content]), [String])
runCP DecodingFunctions
s = (((RWS
   DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
 -> (SourcePos, [Content])
 -> (Either String a, (SourcePos, [Content]), [String]))
-> (SourcePos, [Content])
-> RWS
     DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
-> (Either String a, (SourcePos, [Content]), [String])
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((RWS
    DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
  -> (SourcePos, [Content])
  -> (Either String a, (SourcePos, [Content]), [String]))
 -> (SourcePos, [Content])
 -> RWS
      DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
 -> (Either String a, (SourcePos, [Content]), [String]))
-> (DecodingFunctions
    -> RWS
         DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
    -> (SourcePos, [Content])
    -> (Either String a, (SourcePos, [Content]), [String]))
-> DecodingFunctions
-> (SourcePos, [Content])
-> RWS
     DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
-> (Either String a, (SourcePos, [Content]), [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((DecodingFunctions
  -> RWS
       DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
  -> (SourcePos, [Content])
  -> (Either String a, (SourcePos, [Content]), [String]))
 -> DecodingFunctions
 -> (SourcePos, [Content])
 -> RWS
      DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
 -> (Either String a, (SourcePos, [Content]), [String]))
-> ((RWS
       DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
     -> DecodingFunctions
     -> (SourcePos, [Content])
     -> (Either String a, (SourcePos, [Content]), [String]))
    -> DecodingFunctions
    -> RWS
         DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
    -> (SourcePos, [Content])
    -> (Either String a, (SourcePos, [Content]), [String]))
-> (RWS
      DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
    -> DecodingFunctions
    -> (SourcePos, [Content])
    -> (Either String a, (SourcePos, [Content]), [String]))
-> DecodingFunctions
-> (SourcePos, [Content])
-> RWS
     DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
-> (Either String a, (SourcePos, [Content]), [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RWS
   DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
 -> DecodingFunctions
 -> (SourcePos, [Content])
 -> (Either String a, (SourcePos, [Content]), [String]))
-> DecodingFunctions
-> RWS
     DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
-> (SourcePos, [Content])
-> (Either String a, (SourcePos, [Content]), [String])
forall a b c. (a -> b -> c) -> b -> a -> c
flip) RWS
  DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
-> DecodingFunctions
-> (SourcePos, [Content])
-> (Either String a, (SourcePos, [Content]), [String])
forall r w s a. RWS r w s a -> r -> s -> (a, s, w)
runRWS DecodingFunctions
s (SourcePos
forall a. HasCallStack => a
undefined, [Content]
forall a. HasCallStack => a
undefined) (RWS
   DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
 -> (Either String a, (SourcePos, [Content]), [String]))
-> (ContentParser a
    -> RWS
         DecodingFunctions
         [String]
         (SourcePos, [Content])
         (Either String a))
-> ContentParser a
-> (Either String a, (SourcePos, [Content]), [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContentParser a
-> RWS
     DecodingFunctions [String] (SourcePos, [Content]) (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT