--------------------------------------------------------------------------
--
-- Module      :  Uniform.PandocImports
-- | read and write pandoc files (intenal rep of pandoc written to disk)
-- von hier Pandoc spezifisches imortieren
-- nich exportieren nach aussen
--
-- das ist, was von pandoc zum import gebraucht wird
-------------------------------
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE LiberalTypeSynonyms #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans 
            -fno-warn-missing-signatures
            -fno-warn-missing-methods 
            -fno-warn-duplicate-exports   #-}

module Uniform.PandocImports
  ( module Uniform.PandocImports,
    Pandoc (..)
    , writeTexSnip2
  )
where

import Text.Pandoc
  ( CiteMethod (Natbib),
    Meta,
    MetaValue,
    Pandoc (..),
    WriterOptions
      ( writerCiteMethod,
        writerExtensions,
        writerHighlightStyle
      )
    , def
    , writeLaTeX,
  )
import qualified Text.Pandoc as Pandoc
import Text.Pandoc.Highlighting (tango)
import Text.Pandoc.Shared (stringify)
import Uniform.Json
      
-- import Uniform.Yaml  
import UniformBase
-- import Data.Aeson.Types ( parseMaybe )

  --  zero = Pandoc.Null

instance Zeros Pandoc where
  zero :: Pandoc
zero = Meta -> [Block] -> Pandoc
Pandoc forall z. Zeros z => z
zero forall z. Zeros z => z
zero

instance Zeros Text.Pandoc.Meta where
  zero :: Meta
zero = forall a. Monoid a => a
mempty

-- | Handle possible pandoc failure within the PandocIO Monad
unPandocM :: Pandoc.PandocIO a -> ErrIO a
unPandocM :: forall a. PandocIO a -> ErrIO a
unPandocM PandocIO a
op1 = forall a. PandocIO a -> ErrIO a
callPandoc PandocIO a
op1
--   do
--     res <-
--       callIO $
--         Pandoc.runIO op1
--     either
--       ( \e -> do
--           throwErrorT [e]
--       )
--       return
--       res
--     `catchError` ( \e -> do
--                      throwErrorT [e]
--                  )

-- callPandoc :: Pandoc.PandocIO a -> ErrIO a
-- callPandoc op1 = 
--     callIO $ Pandoc.runIO op1
--     >>= 
--     either (\e -> throwError . showT $  e)  return  
--   `catchError` (\e -> throwError . showT $ e)

-- callPandoc1 :: Pandoc.PandocIO a -> ErrIO a
-- callPandoc1 op1 = 
--     callIO $ Pandoc.runIO op1
--     >>= 
--     either ( throwError . showT  )  return  
--  `catchError` (throwError . showT)

callPandoc :: Pandoc.PandocIO a -> ErrIO a
callPandoc :: forall a. PandocIO a -> ErrIO a
callPandoc PandocIO a
op1 = do
    Either PandocError a
res <- forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ forall a. PandocIO a -> IO (Either PandocError a)
Pandoc.runIO PandocIO a
op1
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Text -> ErrIO a
throwErrorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> Text
showT) forall (m :: * -> *) a. Monad m => a -> m a
return Either PandocError a
res
  forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchError` (forall a. Text -> ErrIO a
throwErrorT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => a -> Text
showT)


getMeta :: Pandoc -> Pandoc.Meta
getMeta :: Pandoc -> Meta
getMeta (Pandoc.Pandoc Meta
m [Block]
_) = Meta
m

putMeta :: Pandoc.Meta -> Pandoc -> Pandoc
putMeta :: Meta -> Pandoc -> Pandoc
putMeta Meta
m1 (Pandoc Meta
_ [Block]
p0) = Meta -> [Block] -> Pandoc
Pandoc Meta
m1 [Block]
p0

fromJSONValue :: FromJSON a => Value -> Maybe a
fromJSONValue :: forall a. FromJSON a => Value -> Maybe a
fromJSONValue = forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe forall a. FromJSON a => Value -> Parser a
parseJSON

-- | Flatten a Pandoc 'Meta' into a well-structured JSON object,  
-- adapted from https://hackage.haskell.org/package/slick-1.1.1.0/docs/src/Slick.Pandoc.html#flattenMeta
flattenMeta :: Pandoc.Meta -> Value
flattenMeta :: Meta -> Value
flattenMeta (Pandoc.Meta Map Text MetaValue
meta) = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaValue -> Value
go Map Text MetaValue
meta
  where
    go :: MetaValue -> Value
    go :: MetaValue -> Value
go (Pandoc.MetaMap Map Text MetaValue
m) = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaValue -> Value
go Map Text MetaValue
m
    go (Pandoc.MetaList [MetaValue]
m) = forall a. ToJSON a => [a] -> Value
toJSONList forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MetaValue -> Value
go [MetaValue]
m
    go (Pandoc.MetaBool Bool
m) = forall a. ToJSON a => a -> Value
toJSON Bool
m
    go (Pandoc.MetaString Text
m) = forall a. ToJSON a => a -> Value
toJSON Text
m
    go (Pandoc.MetaInlines [Inline]
m) = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> Text
stringify [Inline]
m
    go (Pandoc.MetaBlocks [Block]
m) = forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ forall a. Walkable Inline a => a -> Text
stringify [Block]
m

-- readYaml2value :: Path Abs File -> ErrIO Value
-- -- | read a yaml file to a value
-- -- error when syntax issue
-- readYaml2value fp = do
--   t <- read8 fp yamlFileType
--   return . yaml2value $ t

latexOptions :: WriterOptions
-- | reasonable extension - crucial!
latexOptions :: WriterOptions
latexOptions =
  forall a. Default a => a
def
    { writerHighlightStyle :: Maybe Style
writerHighlightStyle = forall a. a -> Maybe a
Just Style
tango,
      writerCiteMethod :: CiteMethod
writerCiteMethod = CiteMethod
Natbib,
      -- Citeproc                        -- use citeproc to render them
      --           | Natbib                        -- output natbib cite commands
      --           | Biblatex                      -- output biblatex cite commands
      writerExtensions :: Extensions
writerExtensions =
        [Extension] -> Extensions
Pandoc.extensionsFromList
          [ Extension
Pandoc.Ext_raw_tex --Allow raw TeX (other than math)
          -- , Pandoc.Ext_shortcut_reference_links
          -- , Pandoc.Ext_spaced_reference_links
          -- , Pandoc.Ext_citations     
          , Extension
Pandoc.Ext_implicit_figures -- a figure alone will have a caption !!      
          -- <-- this is the important extension for bibTex
          ]
    }



writeTexSnip2 :: Pandoc -> ErrIO Text
-- write a latex file from a pandoc doc
writeTexSnip2 :: Pandoc -> ErrIO Text
writeTexSnip2 Pandoc
pandocRes = do
  Text
p <- forall a. PandocIO a -> ErrIO a
unPandocM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
PandocMonad m =>
WriterOptions -> Pandoc -> m Text
writeLaTeX WriterOptions
latexOptions Pandoc
pandocRes
  forall (m :: * -> *) a. Monad m => a -> m a
return Text
p