{-# LANGUAGE OverloadedStrings #-}

module Language.Ltml.HTML.Test () where

import Data.ByteString.Lazy (writeFile)
import Language.Ltml.HTML
import Language.Ltml.HTML.CSS (writeCss)
import Language.Ltml.HTML.CSS.Util (addHtmlHeader)
import Language.Ltml.HTML.Export (renderZip)
import Language.Ltml.Tree.Example.Fpo (fpoTree)
import Language.Ltml.Tree.Parser (TreeError (..))
import Language.Ltml.Tree.ToLtml (treeToLtml)
import Lucid (renderToFile)
import System.Directory (removeDirectoryRecursive)
import Prelude hiding (writeFile)

parseTest :: IO ()
parseTest :: IO ()
parseTest = do
    case FlaggedInputTree' -> Either TreeError (Flagged' DocumentContainer)
treeToLtml FlaggedInputTree'
fpoTree of
        Left (TreeError String
errMsg) -> String -> IO ()
putStrLn String
errMsg
        Right Flagged' DocumentContainer
markedDocCon -> do
            let (Html ()
body, Css
css) = Flagged' DocumentContainer -> (Html (), Css)
renderHtmlCss Flagged' DocumentContainer
markedDocCon
             in do
                    (RenderedTocEntry -> IO ()) -> [RenderedTocEntry] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RenderedTocEntry -> IO ()
forall a. Show a => a -> IO ()
print ([RenderedTocEntry] -> IO ()) -> [RenderedTocEntry] -> IO ()
forall a b. (a -> b) -> a -> b
$ Flagged' DocumentContainer -> [RenderedTocEntry]
renderTocList Flagged' DocumentContainer
markedDocCon
                    String -> Html () -> IO ()
forall a. String -> Html a -> IO ()
renderToFile
                        String
"src/Language/Ltml/HTML/Test/out.html"
                        (String -> String -> Html () -> Html ()
forall title. ToHtml title => title -> String -> Html () -> Html ()
addHtmlHeader (String
"Generated Document Preview" :: String) String
"out.css" Html ()
body)
                    Css -> String -> IO ()
writeCss Css
css String
"src/Language/Ltml/HTML/Test/out.css"

-- prettyPrint markedDocCon

-------------------------------------------------------------------------------

-- exportTest :: IO ()
-- exportTest =
--     let testDir = "src/Language/Ltml/HTML/Test/export"
--      in do
--             _ <- case treeToLtml fpoTree of
--                 Left _ -> error "parsing failed"
--                 Right docCon -> exportDocument docCon testDir
--             _ <- getLine
--             removeDirectoryRecursive testDir

zipTest :: IO ()
zipTest :: IO ()
zipTest = do
    case FlaggedInputTree' -> Either TreeError (Flagged' DocumentContainer)
treeToLtml FlaggedInputTree'
fpoTree of
        Left (TreeError String
errMsg) -> String -> IO ()
forall a. HasCallStack => String -> a
error String
errMsg
        Right Flagged' DocumentContainer
docCon -> do
            Maybe ByteString
mBs <- Flagged' DocumentContainer -> IO (Maybe ByteString)
renderZip Flagged' DocumentContainer
docCon
            case Maybe ByteString
mBs of
                Maybe ByteString
Nothing -> String -> IO ()
putStrLn String
"AST has errors! No ZIP"
                Just ByteString
bs -> String -> ByteString -> IO ()
writeFile String
"src/Language/Ltml/HTML/Test/export.zip" ByteString
bs

-------------------------------------------------------------------------------