{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Media.Subtitles.SRT.Dhall
  ( srtDecoder,
  )
where

import qualified Data.Attoparsec.Text as A
import Data.Either.Validation
import Data.Functor.Contravariant
import Data.Text as T
import Dhall
import Formatting
import Media.Subtitles.SRT
import Media.Subtitles.SRT.Attoparsec
import Media.Subtitles.SRT.Formatting

instance FromDhall SRT where
  autoWith :: InputNormalizer -> Decoder SRT
autoWith InputNormalizer
options = InputNormalizer -> Decoder SRT
srtDecoder InputNormalizer
options

srtDecoder :: InputNormalizer -> Decoder SRT
srtDecoder :: InputNormalizer -> Decoder SRT
srtDecoder InputNormalizer
opts =
  Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
Decoder {Expector (Expr Src Void)
Expr Src Void -> Extractor Src Void SRT
extract :: Expr Src Void -> Extractor Src Void SRT
expected :: Expector (Expr Src Void)
expected :: Expector (Expr Src Void)
extract :: Expr Src Void -> Extractor Src Void SRT
..}
  where
    textDecoder :: Decoder Text
    textDecoder :: Decoder Text
textDecoder = InputNormalizer -> Decoder Text
forall a. FromDhall a => InputNormalizer -> Decoder a
autoWith InputNormalizer
opts

    extract :: Expr Src Void -> Extractor Src Void SRT
extract Expr Src Void
expression =
      case Decoder Text -> Expr Src Void -> Extractor Src Void Text
forall a. Decoder a -> Expr Src Void -> Extractor Src Void a
Dhall.extract Decoder Text
textDecoder Expr Src Void
expression of
        Success Text
x -> case Parser SRT -> Text -> Either String SRT
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser SRT
parseSRT Text
x of
          Left String
exception -> Text -> Extractor Src Void SRT
forall s a b. Text -> Extractor s a b
Dhall.extractError (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. Show a => a -> String
show String
exception)
          Right SRT
k -> SRT -> Extractor Src Void SRT
forall e a. a -> Validation e a
Success SRT
k
        Failure ExtractErrors Src Void
e -> ExtractErrors Src Void -> Extractor Src Void SRT
forall e a. e -> Validation e a
Failure ExtractErrors Src Void
e

    expected :: Expector (Expr Src Void)
expected = Decoder Text -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
Dhall.expected Decoder Text
textDecoder

instance ToDhall SRT where
  injectWith :: InputNormalizer -> Encoder SRT
injectWith = (Encoder Text -> Encoder SRT)
-> (InputNormalizer -> Encoder Text)
-> InputNormalizer
-> Encoder SRT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((SRT -> Text) -> Encoder Text -> Encoder SRT
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap (Format Text (SRT -> Text) -> SRT -> Text
forall a. Format Text a -> a
sformat Format Text (SRT -> Text)
forall r. Format r (SRT -> r)
srtf)) InputNormalizer -> Encoder Text
forall a. ToDhall a => InputNormalizer -> Encoder a
injectWith