--------------------------------------------------------------------------
--
-- 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.Markdown
  (markdownFileType
  , MarkdownText, unMT, makeMT
  , readMarkdown2
  , extMD
--   , readMarkdownFile2docrep
  )
where

  
import qualified Text.Pandoc as Pandoc
import UniformBase

import Uniform.PandocImports ( Pandoc, callPandoc )

-- readMarkdownFile2docrep  :: NoticeLevel -> Path Abs Dir -> Path Abs File -> ErrIO Docrep 
-- -- read a markdown file and convert to docrep
-- readMarkdownFile2docrep debug doughP fnin = do
--     when (inform debug) $ putIOwords 
--         ["getFile2index fnin", showPretty fnin]

--     mdfile <- read8 fnin markdownFileType 
--     pd <- readMarkdown2 mdfile
--     -- could perhaps "need" all ix as files?

--     let doc1 = pandoc2docrep doughP fnin pd
--     return doc1

     
----------------------------- -------------------------Markdown

extMD :: Extension
extMD :: Extension
extMD = FilePath -> Extension
Extension FilePath
"md"

newtype MarkdownText = MarkdownText Text
  deriving (Int -> MarkdownText -> ShowS
[MarkdownText] -> ShowS
MarkdownText -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MarkdownText] -> ShowS
$cshowList :: [MarkdownText] -> ShowS
show :: MarkdownText -> FilePath
$cshow :: MarkdownText -> FilePath
showsPrec :: Int -> MarkdownText -> ShowS
$cshowsPrec :: Int -> MarkdownText -> ShowS
Show, ReadPrec [MarkdownText]
ReadPrec MarkdownText
Int -> ReadS MarkdownText
ReadS [MarkdownText]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MarkdownText]
$creadListPrec :: ReadPrec [MarkdownText]
readPrec :: ReadPrec MarkdownText
$creadPrec :: ReadPrec MarkdownText
readList :: ReadS [MarkdownText]
$creadList :: ReadS [MarkdownText]
readsPrec :: Int -> ReadS MarkdownText
$creadsPrec :: Int -> ReadS MarkdownText
Read, MarkdownText -> MarkdownText -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MarkdownText -> MarkdownText -> Bool
$c/= :: MarkdownText -> MarkdownText -> Bool
== :: MarkdownText -> MarkdownText -> Bool
$c== :: MarkdownText -> MarkdownText -> Bool
Eq, Eq MarkdownText
MarkdownText -> MarkdownText -> Bool
MarkdownText -> MarkdownText -> Ordering
MarkdownText -> MarkdownText -> MarkdownText
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MarkdownText -> MarkdownText -> MarkdownText
$cmin :: MarkdownText -> MarkdownText -> MarkdownText
max :: MarkdownText -> MarkdownText -> MarkdownText
$cmax :: MarkdownText -> MarkdownText -> MarkdownText
>= :: MarkdownText -> MarkdownText -> Bool
$c>= :: MarkdownText -> MarkdownText -> Bool
> :: MarkdownText -> MarkdownText -> Bool
$c> :: MarkdownText -> MarkdownText -> Bool
<= :: MarkdownText -> MarkdownText -> Bool
$c<= :: MarkdownText -> MarkdownText -> Bool
< :: MarkdownText -> MarkdownText -> Bool
$c< :: MarkdownText -> MarkdownText -> Bool
compare :: MarkdownText -> MarkdownText -> Ordering
$ccompare :: MarkdownText -> MarkdownText -> Ordering
Ord)

-- | a wrapper around Markdonw text
unMT :: MarkdownText -> Text
unMT :: MarkdownText -> Text
unMT (MarkdownText Text
a) = Text
a --needed for other ops

makeMT :: Text -> MarkdownText 
makeMT :: Text -> MarkdownText
makeMT = Text -> MarkdownText
MarkdownText 

instance Zeros MarkdownText where
  zero :: MarkdownText
zero = Text -> MarkdownText
MarkdownText forall z. Zeros z => z
zero

markdownFileType :: TypedFile5 Text MarkdownText
markdownFileType :: TypedFile5 Text MarkdownText
markdownFileType =
  TypedFile5 {tpext5 :: Extension
tpext5 = Extension
extMD} :: TypedFile5 Text MarkdownText

instance TypedFiles7 Text MarkdownText where
--  handling Markdown and read them into MarkdownText
  wrap7 :: Text -> MarkdownText
wrap7 Text
a = Text -> MarkdownText
MarkdownText Text
a
  unwrap7 :: MarkdownText -> Text
unwrap7 (MarkdownText Text
a) = Text
a

readMarkdown2 :: MarkdownText -> ErrIO Pandoc
-- | reads the markdown text and produces a pandoc structure
readMarkdown2 :: MarkdownText -> ErrIO Pandoc
readMarkdown2 MarkdownText
text1 =
    forall a. PandocIO a -> ErrIO a
callPandoc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
Pandoc.readMarkdown ReaderOptions
markdownOptions (forall a b. TypedFiles7 a b => b -> a
unwrap7 MarkdownText
text1 :: Text)

-- readMarkdown3 :: Pandoc.ReaderOptions -> MarkdownText -> ErrIO Pandoc
-- readMarkdown3 options text1 =
--     unPandocM $ Pandoc.readMarkdown options (unwrap7 text1::Text)

-- | Reasonable options for reading a markdown file
markdownOptions :: Pandoc.ReaderOptions
markdownOptions :: ReaderOptions
markdownOptions = forall a. Default a => a
Pandoc.def { readerExtensions :: Extensions
Pandoc.readerExtensions = Extensions
exts }
  where
    exts :: Extensions
exts = forall a. Monoid a => [a] -> a
mconcat
        [ [Extension] -> Extensions
Pandoc.extensionsFromList
            [ Extension
Pandoc.Ext_yaml_metadata_block
            -- , Pandoc.Ext_fenced_code-block -- code blocks with ~
            , Extension
Pandoc.Ext_backtick_code_blocks
            , Extension
Pandoc.Ext_fenced_code_attributes  -- eg for haskell code snippets
            , Extension
Pandoc.Ext_auto_identifiers
            -- , Pandoc.Ext_raw_html   -- three extension give markdown_strict
            , Extension
Pandoc.Ext_raw_tex   --Allow raw TeX (other than math)
            , Extension
Pandoc.Ext_shortcut_reference_links
            , Extension
Pandoc.Ext_spaced_reference_links
            , Extension
Pandoc.Ext_footnotes  -- all footnotes
            , Extension
Pandoc.Ext_inline_notes
            , Extension
Pandoc.Ext_citations           -- <-- this is the important extension for bibTex
            , Extension
Pandoc.Ext_implicit_figures  -- a figure alone in a para will have a caption
            , Extension
Pandoc.Ext_header_attributes -- for {.unnumbered}
            , Extension
Pandoc.Ext_lists_without_preceding_blankline
            , Extension
Pandoc.Ext_superscript  -- start and closing ^
            , Extension
Pandoc.Ext_subscript -- start and closing ~
            -- , Pandoc.Ext_short_subsuperscripts  -- only start ^ and ~
            , Extension
Pandoc.Ext_strikeout  -- require ~~ two! before and after
            ]
        , Extensions
Pandoc.githubMarkdownExtensions
        ]

-- instance ToJSON Text
-- writeLaTeX :: PandocMonad m => WriterOptions -> Pandoc -> m Text

-- instance TypedFiles7 Text Text where
--   wrap7 = id
--   unwrap7 = id

-- writeTexSnip2 :: Pandoc -> ErrIO Text
-- -- write a latex file from a pandoc doc
-- writeTexSnip2 pandocRes = do
--   p <- unPandocM $ writeLaTeX latexOptions pandocRes
--   return p