module Tintin.Domain.HtmlFile where

import Tintin.Core
import qualified Tintin.Capabilities.Filesystem as Filesystem
import qualified Tintin.Capabilities.Process as Process
import qualified Tintin.Domain.DocumentationFile as DocumentationFile
import qualified Tintin.Domain.FrontMatter as FrontMatter

import qualified Data.Text as Text


newtype CompilationError = CompilationError Text deriving Show

data Value = Value
  { filename :: Text
  , title    :: Text
  , content  :: Text
  }


fromDocumentationFile :: DocumentationFile.Value
                      -> Value
fromDocumentationFile docfile =
  DocumentationFile.content docfile
   |> ("{-# OPTIONS_GHC -F -pgmF inlitpp #-}\n" <>)
   |> Value (DocumentationFile.filename docfile) docTitle
 where
  docTitle = docfile |> DocumentationFile.frontMatter |> FrontMatter.title


run :: ( Has Filesystem.Capability eff
       , Has Process.Capability eff
       )
    => Value
    -> Effectful eff (Either CompilationError Value)
run Value {..} = do
  Filesystem.Path currentDirectory <- Filesystem.currentDirectory
  let tintinDir = currentDirectory <> "/.stack-work/tintin/"
  let tempDir   = tintinDir <> "temp/"
  let hsFilename = filename
                   |> Text.breakOn ".md"
                   |> fst
                   |> (<> ".hs")
                   |> (tempDir <>)
  let htmlFilename = filename
                     |> Text.breakOn ".md"
                     |> fst
                     |> (<> ".html")
  Filesystem.deleteIfExists (Filesystem.Path tempDir)
  Filesystem.makeDirectory (Filesystem.Path tempDir)
  Filesystem.writeFile (Filesystem.Path hsFilename) content
  result <- Process.read
    (Process.CommandName "stack")
    (Process.Arguments ["runghc", hsFilename, "--", "--no-inlit-wrap"])


  case result of
    Left  (Process.StdErr err) ->
      return (Left $ CompilationError err)

    Right (Process.StdOut msg) ->
      return . Right $ Value
        { filename = htmlFilename
        , content  = msg
        , title    = title
        }