{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
module Text.Compdoc.Dhall where

import Composite.Aeson
import Composite.Record
import Data.Either.Validation
import Data.Void
import qualified Dhall as D
import Data.Text as T
import Text.Compdoc
import Data.Typeable
import Text.Pandoc

-- | Decode a Compdoc value.
compdocDecoder :: WriterOptions -> JsonFormat Void (Record a) -> D.InputNormalizer -> D.Decoder (Record (FContent ': a))
compdocDecoder :: WriterOptions
-> JsonFormat Void (Record a)
-> InputNormalizer
-> Decoder (Record (FContent : a))
compdocDecoder WriterOptions
wopts JsonFormat Void (Record a)
f InputNormalizer
opts =
      Decoder :: forall a.
(Expr Src Void -> Extractor Src Void a)
-> Expector (Expr Src Void) -> Decoder a
D.Decoder
            { extract :: Expr Src Void -> Extractor Src Void (Record (FContent : a))
D.extract = Expr Src Void -> Extractor Src Void (Record (FContent : a))
extractDoc
            , expected :: Expector (Expr Src Void)
D.expected = Expector (Expr Src Void)
expectedDoc
            }
      where
        docDecoder :: D.Decoder Text
        docDecoder :: Decoder Text
docDecoder = InputNormalizer -> Decoder Text
forall a. FromDhall a => InputNormalizer -> Decoder a
D.autoWith InputNormalizer
opts

        extractDoc :: Expr Src Void -> Extractor Src Void (Record (FContent : a))
extractDoc 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
D.extract Decoder Text
docDecoder Expr Src Void
expression of
              Success Text
x -> case ReaderOptions
-> WriterOptions
-> JsonFormat Void (Record a)
-> Text
-> Either SomeException (Record (FContent : a))
forall e (m :: * -> *) (a :: [*]).
(Show e, Typeable e, MonadThrow m) =>
ReaderOptions
-> WriterOptions
-> JsonFormat e (Record a)
-> Text
-> m (Record (Compdoc a))
readMarkdown' ReaderOptions
forall a. Default a => a
def { readerExtensions :: Extensions
readerExtensions = Extensions
pandocExtensions } WriterOptions
wopts JsonFormat Void (Record a)
f Text
x of
                Left SomeException
exception   -> Text -> Extractor Src Void (Record (FContent : a))
forall s a b. Text -> Extractor s a b
D.extractError (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
exception)
                Right Record (FContent : a)
path       -> Record (FContent : a) -> Extractor Src Void (Record (FContent : a))
forall e a. a -> Validation e a
Success Record (FContent : a)
path
              Failure ExtractErrors Src Void
e        -> ExtractErrors Src Void
-> Extractor Src Void (Record (FContent : a))
forall e a. e -> Validation e a
Failure ExtractErrors Src Void
e
        expectedDoc :: Expector (Expr Src Void)
expectedDoc = Decoder Text -> Expector (Expr Src Void)
forall a. Decoder a -> Expector (Expr Src Void)
D.expected Decoder Text
docDecoder