{-# LANGUAGE OverloadedStrings #-}

module Media.Subtitles.SRT.Attoparsec
  ( parseLine,
    parseSRT,
    parseDialog,
  )
where

import Control.Applicative
import Control.Monad.State
import Data.Attoparsec.Text
import Data.Text as T
import Media.Subtitles.SRT
import Media.Timestamp
import Media.Timestamp.Attoparsec

-- | Parse a single line.
--
-- @since 0.1.0.0
parseLine :: Parser Line
parseLine :: Parser Line
parseLine =
  Int -> Range -> Text -> Line
Line (Int -> Range -> Text -> Line)
-> Parser Text Int -> Parser Text (Range -> Text -> Line)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Int
parseIndex Parser Text (Range -> Text -> Line)
-> Parser Text Range -> Parser Text (Text -> Line)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Time -> Parser Text Range
parseRangeA Parser Time
parseTimec Parser Text (Text -> Line)
-> Parser Text () -> Parser Text (Text -> Line)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
endOfLine Parser Text (Text -> Line) -> Parser Text Text -> Parser Line
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text
parseDialog

parseIndex :: Parser Int
parseIndex :: Parser Text Int
parseIndex = Parser Text Int
forall a. Integral a => Parser a
decimal Parser Text Int -> Parser Text () -> Parser Text Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
endOfLine

-- | Parse a dialogue section
--
-- @since 0.1.0.0
parseDialog :: Parser Text
parseDialog :: Parser Text Text
parseDialog = ([Text] -> Text) -> Parser Text [Text] -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> [Text] -> Text
T.intercalate Text
"\n") (Parser Text [Text] -> Parser Text Text)
-> Parser Text [Text] -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ StateT [Text] (Parser Text) () -> [Text] -> Parser Text [Text]
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT StateT [Text] (Parser Text) ()
f []
  where
    f :: StateT [Text] (Parser Text) ()
f = do
      Text
line <- Parser Text Text -> StateT [Text] (Parser Text) Text
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Parser Text Text -> StateT [Text] (Parser Text) Text)
-> Parser Text Text -> StateT [Text] (Parser Text) Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Text Text
takeWhile1 (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isEndOfLine) Parser Text Text -> Parser Text () -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
endOfLine
      ([Text] -> [Text]) -> StateT [Text] (Parser Text) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
        ([Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text
line])
      (Parser Text () -> StateT [Text] (Parser Text) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput StateT [Text] (Parser Text) ()
-> StateT [Text] (Parser Text) () -> StateT [Text] (Parser Text) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> StateT [Text] (Parser Text) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        StateT [Text] (Parser Text) ()
-> StateT [Text] (Parser Text) () -> StateT [Text] (Parser Text) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Parser Text () -> StateT [Text] (Parser Text) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Parser Text ()
endOfLine StateT [Text] (Parser Text) ()
-> StateT [Text] (Parser Text) () -> StateT [Text] (Parser Text) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> StateT [Text] (Parser Text) ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        StateT [Text] (Parser Text) ()
-> StateT [Text] (Parser Text) () -> StateT [Text] (Parser Text) ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT [Text] (Parser Text) ()
f

-- | Parse a whole subtitles file.
--
-- @since 0.1.0.0
parseSRT :: Parser SRT
parseSRT :: Parser SRT
parseSRT = [Line] -> SRT
SRT ([Line] -> SRT) -> Parser Text [Line] -> Parser SRT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Line -> Parser Text [Line]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Line
parseLine