{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}
-- | Filtering a single code block.
module Filter(renderBlock, renderInline) where

import Text.Pandoc.JSON
import qualified Data.Text as T
import Prelude hiding(getLine)

import FindColumns ( tableColumns )
import Alignment ( Processed )
import Token ( MyTok )
import Render.ColSpan ( colspans, numColSpans )
import qualified Render.Debug
import qualified Render.Latex
import qualified Render.HTML
import Debug.Trace(trace)

-- | Render a list of `Processed` token records into the target output format.
renderBlock ::  Format     -- ^ Format string
            ->  Attr       -- ^ Attributes
            -> [Processed] -- ^ Data about alignment
            ->  Block
--renderBlock (Format "text" ) _attrs = RawBlock (Format "html" ) . T.pack . show . colspans
renderBlock :: Format -> Attr -> [Processed] -> Block
renderBlock (Format Text
"text" )  Attr
attrs  = Attr -> Text -> Block
CodeBlock Attr
attrs           (Text -> Block) -> ([Processed] -> Text) -> [Processed] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Processed] -> Text
Render.Debug.render
renderBlock (Format Text
"latex")  Attr
_attrs = Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"latex") (Text -> Block) -> ([Processed] -> Text) -> [Processed] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Processed] -> Text
processLatex
renderBlock (Format Text
"beamer") Attr
_attrs = Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"latex") (Text -> Block) -> ([Processed] -> Text) -> [Processed] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Processed] -> Text
processLatex
renderBlock (Format Text
"html" )  Attr
_attrs = Format -> Text -> Block
RawBlock (Text -> Format
Format Text
"html" ) (Text -> Block) -> ([Processed] -> Text) -> [Processed] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Processed] -> Text
processHTML
-- Debugging option
renderBlock Format
other            Attr
attrs  = Attr -> Text -> Block
CodeBlock Attr
attrs           (Text -> Block) -> ([Processed] -> Text) -> [Processed] -> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> ([Processed] -> String) -> [Processed] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Format -> String
forall a. Show a => a -> String
show Format
other String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (String -> String)
-> ([Processed] -> String) -> [Processed] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Processed] -> String
forall a. Show a => a -> String
show 

-- TODO: inline should strip colspans, and ignore table
-- | Render a list of `Processed` token records into the target output format.
renderInline ::  Format     -- ^ Format string
             ->  Attr       -- ^ Attributes
             -> [(MyTok, T.Text)] -- ^ Data about alignment
             ->  Inline
--render "text" attrs aligned = RawBlock (Format "latex") $ processLatex aligned -- debug
renderInline :: Format -> Attr -> [(MyTok, Text)] -> Inline
renderInline (Format Text
"text" ) Attr
attrs  = Attr -> Text -> Inline
Code      Attr
attrs            (Text -> Inline)
-> ([(MyTok, Text)] -> Text) -> [(MyTok, Text)] -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MyTok, Text)] -> Text
forall a. Field2 a a Text Text => [a] -> Text
Render.Debug.renderInline
renderInline (Format Text
"latex") Attr
_attrs = MathType -> Text -> Inline
Math      MathType
InlineMath       (Text -> Inline)
-> ([(MyTok, Text)] -> Text) -> [(MyTok, Text)] -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MyTok, Text)] -> Text
Render.Latex.latexInline
renderInline (Format Text
"html" ) Attr
_attrs = Format -> Text -> Inline
RawInline (Text -> Format
Format Text
"html" ) (Text -> Inline)
-> ([(MyTok, Text)] -> Text) -> [(MyTok, Text)] -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MyTok, Text)] -> Text
Render.HTML.htmlInline
-- Debugging option
renderInline Format
other            Attr
attrs  = Attr -> Text -> Inline
Code      Attr
attrs            (Text -> Inline)
-> ([(MyTok, Text)] -> Text) -> [(MyTok, Text)] -> Inline
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> ([(MyTok, Text)] -> String) -> [(MyTok, Text)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(MyTok, Text)] -> String
forall a. Show a => a -> String
show

-- | Convert a list of input token records to raw LaTeX.
processLatex :: [Processed] -> T.Text
processLatex :: [Processed] -> Text
processLatex [Processed]
processed = Int -> [[TokensWithColSpan]] -> Text
Render.Latex.latexFromColSpans ([Processed] -> Int
numColSpans [Processed]
processed) [[TokensWithColSpan]]
cs
  where
    cs :: [[TokensWithColSpan]]
cs = [Processed] -> [[TokensWithColSpan]]
colspans [Processed]
processed

-- | Convert a list of input token records to raw HTML.
processHTML :: [Processed] -> T.Text
processHTML :: [Processed] -> Text
processHTML  = [[TokensWithColSpan]] -> Text
Render.HTML.htmlFromColSpans
             ([[TokensWithColSpan]] -> Text)
-> ([Processed] -> [[TokensWithColSpan]]) -> [Processed] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Processed] -> [[TokensWithColSpan]]
colspans