content: module Tintin.Domain.HtmlFile where
  
  import Tintin.Core
  require Tintin.Capabilities.Filesystem
  require Tintin.Capabilities.Process
  require Tintin.Domain.DocumentationFile
  require Tintin.Domain.FrontMatter
  require Data.Text
  
  
  data BuildTool
    = Stack
    | Cabal
  
  newtype CompilationError = CompilationError Text deriving Show
  
  showCompilationError :: CompilationError
                       -> Text
  showCompilationError (CompilationError e) = "CompilationError\n" <> e
  
  data HtmlFile = HtmlFile
    { filename :: Text
    , title    :: Text
    , content  :: Text
    }
  
  
  fromDocumentationFile :: DocumentationFile
                        -> HtmlFile
  fromDocumentationFile docfile =
    DocumentationFile.content docfile
     & ("{-# OPTIONS_GHC -F -pgmF inlitpp #-}\n" <>)
     & HtmlFile (DocumentationFile.filename docfile) docTitle
   where
    docTitle = docfile & DocumentationFile.frontMatter & FrontMatter.title
  
  
  run :: ( Has Filesystem.Capability eff
         , Has Process.Capability eff
         )
      => BuildTool
      -> HtmlFile
      -> Effectful eff (Either CompilationError HtmlFile)
  run buildTool HtmlFile {..} = 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 <- case buildTool of
                Stack -> Process.read
                         (Process.CommandName "stack")
                         (Process.Arguments ["runghc", hsFilename, "--", "--no-inlit-wrap"])
                Cabal -> Process.read
                         (Process.CommandName "runghc")
                         (Process.Arguments [hsFilename, "--no-inlit-wrap"])
  
    case result of
      Left  (Process.StdErr err) ->
        return (Left $ CompilationError err)
  
      Right (Process.StdOut msg) ->
        return . Right $ HtmlFile
          { filename = htmlFilename
          , content  = msg
          , title    = title
          }
  
  