import Distribution.Simple
import System.Directory
import System.FilePath
import Text.Pandoc
import Text.Pandoc.Shared
import qualified System.IO.UTF8 as U

-- To do:

main = defaultMainWithHooks hooks

hooks :: UserHooks
hooks = simpleUserHooks {postBuild = postBuildHook}

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

{- Haddock creates its documentation in the form of a set of files in
dist/doc/html/Hydra.  These files have names matching *.html, *.gif,
*.css, *.js, Hydra.haddock.  After running haddock, we have:

  dist/doc/html/Hydra/(files created by Haddock)

Hydra has much more extensive documentation, produced by pandoc from
sources in doc.  The top level file in this is index.html.  To avoid
conflicts between the primary Hydra documentation and the API
documentation from haddock, the following steps are taken:

  1. A list of files in dist/doc/html/Hydra/ is created,
     and named haddock_files

  2. A directory dist/doc/html/Hydra/haddock is created

  3. All the files in dist/doc/html/Hydra[haddock_files] are copied to
     dist/doc/html/Hydra/haddock

  4. All the files in dist/doc/html/Hydra[haddock_files] are removed

  5. Pandoc is run on the documentation source files, with the results
     placed in dist/doc/html/Hydra.  These files contain relative
     pointers (URLs) into the haddock documentation.

The result is a documentation directory in the same place Cabal
expects to find it --- dist/doc/html/Hydra --- which contains the
Hydra documentation as well as the API reference produced by haddock.

 -}

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

{- The csslink string is html to be incorporated into the page; it
loads the css style file.  This is placed into the haddock directory,
and given the name haddock.css, so the html files generated by haddock
will find it.  The files generated by pandoc also look there, so only
one copy of the style file needs to be created. -}

csslink :: String
csslink =
  "<link rel=\"stylesheet\" " ++
  "href=\"style.css\" type=\"text/css\" media=\"all\" />"

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

postBuildHook args flags packageDescription localBuildInfo =
  do putStrLn (take 72 (repeat '-'))
     putStrLn "running postBuildHook"

     createDirectoryIfMissing True
       (joinPath ["doc", "html"])

     createDirectoryIfMissing True
       (joinPath ["doc", "html", "figures"])

     putStrLn "Running pandoc..."
     runPandoc
     putStrLn "Pandoc finished"

     putStrLn (take 72 (repeat '-'))

     figure_files <- getDirectoryContents
                       (joinPath ["doc", "src", "figures", "xfig"])

     putStrLn ("Figure files: " ++
                concat (map ((++"\n") . show) figure_files))

     copy_files
       (joinPath ["doc", "src", "figures", "xfig"])
       (joinPath ["doc", "html", "figures"])
       figure_files

     copyFile
       (joinPath ["doc", "src", "style.css"])
       (joinPath ["doc", "html", "style.css"])

     copyFile
       "Sigma16.cabal"
       (joinPath ["doc","html", "Sigma16.cabal"])

--     copyFile
--       (joinPath ["examples", "Add.asm.src.txt"])
--       (joinPath ["doc", "html", "Add.asm.src.txt"])

     putStrLn (take 72 (repeat '-'))

     return ()


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

move_files src dest [] = return ()
move_files src dest (x:xs) =
  do putStrLn x
     if head x == '.' || x=="haddock" || x=="figures"
       then putStrLn ("Skipping file <" ++ x ++ ">")
       else do let srcpath = joinPath [src,x]
               let destpath = joinPath [dest,x]
               putStrLn ("Moving <" ++ srcpath ++
                         "> to <" ++ destpath ++ ">")
               renameFile srcpath destpath
     move_files src dest xs


copy_files src dest [] = return ()
copy_files src dest (x:xs) =
  do putStrLn x
     let ext = takeExtension x
     let srcpath = joinPath [src,x]
     let destpath = joinPath [dest,x]
     putStrLn ("filepath = <" ++ x ++ "> extension = <" ++ ext ++ ">")
     if head x == '.' || ext/=".png"
       then putStrLn ("Skipping file <" ++ x ++ ">")
       else do putStrLn ("Copying <" ++ srcpath ++
                         "> to <" ++ destpath ++ ">")
               copyFile srcpath destpath
     copy_files src dest xs


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

markdownToHtml :: WriterOptions -> String -> String
markdownToHtml opts =
  (writeHtmlString opts) . readMarkdown defaultParserState

mkHtml :: String -> String -> WriterOptions -> IO ()
mkHtml infilepath outfilepath opts =
  do inp <- U.readFile infilepath
     let outp = markdownToHtml opts inp
     writeFile outfilepath outp

runPandoc =
  do 
     putStrLn "Building index.html"

     mkHtml
       (joinPath ["doc", "src", "index.txt"])
       (joinPath ["index.html"])
       (defaultWriterOptions 
         { writerStandalone = True
         , writerIncludeBefore = csslink
         })

     mkHtml
       (joinPath ["doc", "src", "overview.txt"])
       (joinPath ["doc", "html", "overview.html"])
       (defaultWriterOptions
         { writerIncludeBefore = csslink
         , writerStandalone = True
         , writerTableOfContents = True
         })

     mkHtml
       (joinPath ["doc", "src", "programming.txt"])
       (joinPath ["doc", "html", "programming.html"])
       (defaultWriterOptions
         { writerIncludeBefore = csslink
         , writerStandalone = True
         , writerTableOfContents = True
         , writerHTMLMathMethod = LaTeXMathML Nothing
         })

     mkHtml
       (joinPath ["doc", "src", "architecture.txt"])
       (joinPath ["doc", "html", "architecture.html"])
       (defaultWriterOptions
         { writerIncludeBefore = csslink
         , writerStandalone = True
         , writerTableOfContents = True
         , writerHTMLMathMethod = LaTeXMathML Nothing
         })

     mkHtml
       (joinPath ["doc", "src", "assembly.txt"])
       (joinPath ["doc", "html", "assembly.html"])
       (defaultWriterOptions
         { writerIncludeBefore = csslink
         , writerStandalone = True
         , writerTableOfContents = True
         , writerHTMLMathMethod = LaTeXMathML Nothing
         })

     mkHtml
       (joinPath ["doc", "src", "linking.txt"])
       (joinPath ["doc", "html", "linking.html"])
       (defaultWriterOptions
         { writerIncludeBefore = csslink
         , writerStandalone = True
         , writerTableOfContents = True
         , writerHTMLMathMethod = LaTeXMathML Nothing
         })

     mkHtml
       (joinPath ["doc", "src", "execution.txt"])
       (joinPath ["doc", "html", "execution.html"])
       (defaultWriterOptions
         { writerIncludeBefore = csslink
         , writerStandalone = True
         , writerTableOfContents = True
         , writerHTMLMathMethod = LaTeXMathML Nothing
         })

     mkHtml
       (joinPath ["doc", "src", "tutorial.txt"])
       (joinPath ["doc", "html", "tutorial.html"])
       (defaultWriterOptions
         { writerIncludeBefore = csslink
         , writerStandalone = True
         , writerTableOfContents = True
         , writerHTMLMathMethod = LaTeXMathML Nothing
         })

     mkHtml
       (joinPath ["doc", "src", "colophon.txt"])
       (joinPath ["doc", "html", "colophon.html"])
       (defaultWriterOptions
         { writerIncludeBefore = csslink
         , writerStandalone = True
         , writerTableOfContents = True
         , writerHTMLMathMethod = LaTeXMathML Nothing
         })

     mkHtml
       "README"
       (joinPath ["doc", "html", "README.html"])
       (defaultWriterOptions
         { writerIncludeBefore = csslink
         , writerStandalone = True
         , writerTableOfContents = True
         })

     mkHtml
       "INSTALL"
       (joinPath ["doc", "html", "INSTALL.html"])
       (defaultWriterOptions
         { writerIncludeBefore = csslink
         , writerStandalone = True
         , writerTableOfContents = True
         })

     mkHtml
       "LICENSE"
--       "dist/doc/html/Hydra/LICENSE.html"
       (joinPath ["doc", "html", "LICENSE.html"])
       (defaultWriterOptions
         { writerIncludeBefore = csslink
         , writerStandalone = True
         , writerTableOfContents = True
         })

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