view Main.hs @ 4:54841a765f41 tip

Updated Homepage
author Benedikt Fluhr <http://bfluhr.com>
date Tue, 08 Aug 2017 09:24:43 +0200
parents db60ad62afaa
children
line wrap: on
line source
import Data.Default
import Data.Maybe
import Data.Tuple
import Data.List as L
import System.Directory (createDirectoryIfMissing, copyFile)
import Network.HTTP.Conduit (simpleHttp)
import Development.Shake
import Development.Shake.FilePath

import qualified Control.Monad as M
import qualified Control.Monad.Extra as ME
import qualified Data.ByteString.Lazy as B
import qualified Data.Text.Lazy.IO as TIO

import qualified Text.Pandoc as P
import qualified Text.Pandoc.Options as O
import qualified Text.HTML.DOM as DOM
import           Text.Blaze.Html
import qualified Text.Blaze.Html5 as H
import           Text.Blaze.Html.Renderer.Text (renderHtml)

import qualified Text.MultidocRules as MR

import Templates

build :: FilePath
build = "_website"

tmp :: FilePath
tmp = "_tmp"

srcDir :: FilePath
srcDir = "content"

lift2Action :: Show e => Either e a -> Action a
lift2Action (Left  errMsg) = (error . show) errMsg
lift2Action (Right val   ) = return val

-- needDir :: FilePath -> Action ()
-- needDir dir = do
--   mds <- getDirectoryFiles dir ["*.md"]
--   need $ L.map ( (-<.> "html") . (build </>) . dropDirectory1 ) mds


main = shakeArgs shakeOptions { shakeFiles = tmp } $ do

  -- Website Content:
  
  action $ do
    src_files <- getDirectoryFiles srcDir [ "*.md"
                                          , "*/*.md"
                                          , "*.html"
                                          , "*/*.html"
                                          ]
    need $ L.map ( (build </>) . (-<.> "html") ) src_files

  want [ build </> "notes/index.html"
       , build </> "pure-min.css"
       , build </> "layout.css"
       , build </> "sections.css"
       , build </> ".htaccess"
       ]

  [ build </> "*.html", build </> "*/*.html" ] |%> \out -> do
    let src_file = srcDir </> (dropExtension . dropDirectory1) out
    let get_from_html = do
          need [src_file <.> "html"]
          liftIO $ MR.get_title_and_body <$> DOM.readFile (src_file <.> "html")
        get_from_markdown = do
          pandoc@(P.Pandoc meta _) <- readFile' ( src_file <.> "md" )
            >>= lift2Action . P.readMarkdown def { O.readerSmart = True }
          return ( P.writeHtml def
                   $ P.Pandoc P.nullMeta [P.Plain (P.docTitle meta)]
                 , wrapContainer $ P.writeHtml def pandoc
                 )
    (title, body) <- ME.ifM ( doesFileExist $ src_file <.> "html"
                            ) get_from_html get_from_markdown
    liftIO
      $ TIO.writeFile out
      $ renderHtml
      $ template ( dropDirectory1 $ takeDirectory out
                 ) Nothing ( H.title title ) body
      
    -- src <- readFile' md
    -- liftIO $ do
    --   pandoc@(P.Pandoc meta _) <- lift2IO $
    --                               P.readMarkdown def { O.readerSmart = True }
    --                               src
    --   createDirectoryIfMissing True outDir
    --   TIO.writeFile out $ renderHtml $ template (
    --     dropDirectory1 $ outDir
    --     ) Nothing (
    --     H.title $ P.writeHtml def (
    --        P.Pandoc P.nullMeta [P.Plain (P.docTitle meta)]
    --        )
    --     ) (
    --     wrapContainer $ P.writeHtml def pandoc
    --     )
  
  -- build </> "notes/index.html" %> \out -> liftIO $ do
  --   let outDir = takeDirectory out
  --   createDirectoryIfMissing True outDir
  --   TIO.writeFile out $ renderHtml $ template (
  --     dropDirectory1 outDir
  --     ) Nothing (
  --     H.title $ toHtml "Notes"
  --     ) (
  --     notesTemplate $ L.zip ["Persistence Cohomology"] [
  --        L.zip perCohoFiles MR.formats ++ [("../hg/perCoho", "Source")]
  --        ]
  --     )
  
  build </> "pure-min.css" %> \out -> liftIO $ do
    createDirectoryIfMissing True $ takeDirectory out
    ( simpleHttp "http://yui.yahooapis.com/pure/0.6.0/pure-min.css"
      >>= B.writeFile out )

  build </> "layout.css" %> \out ->
    copyFile' (MR.md_dataDir def </> takeFileName out) out

  build </> "*.css" %> \out ->
    copyFile' ("add-stylesheets" </> takeFileName out) out

  build </> ".htaccess" %> \out ->
    copyFile' ("content" </> takeFileName out) out

  -- 'perCoho' Document

  fst $ MR.makeRules def { MR.tmpDir = Just (tmp </> "perCoho")
                         , MR.mb_template = Just $
                                            template "notes/perCoho" Nothing
                         } "perCoho" ( build </> "notes" )

  -- 'interleavings-1d' Document
      
  let
    mpl_scripts = ["2functions-intro", "first-examples", "example-epigraph"]
    pngs = ["logo-grayscale.png", "logo-grayscale-trafo.png"]
    -- Input:
    interleavings_1d = "interleavings-1d"
    img = interleavings_1d </> "img"
    -- Output:
    tmp_interleavings_1d = tmp </> interleavings_1d
    mpl = tmp_interleavings_1d </> "img" </> "mpl"
    mpl_script_paths = L.map (mpl </>) mpl_scripts
    pngs_paths = L.map ((tmp_interleavings_1d </> "img") </>) pngs

  mpl </> "matplotlibrc" %> \out -> do
    liftIO $ createDirectoryIfMissing True mpl
    copyFile' (img </> "matplotlibrc") out

  mpl_script_paths |%> \out -> do
    let mpl_script = takeFileName out
    need [img </> mpl_script, mpl </> "matplotlibrc"]
    liftIO $ copyFile (img </> mpl_script) out
    cmd (Cwd mpl) ("." </> mpl_script)

  pngs_paths |%> \out -> liftIO $ do
    createDirectoryIfMissing True $ takeDirectory out
    ( simpleHttp ("https://bfluhr.tucana.uberspace.de/bucket/ma-thesis-img/" ++
                  takeFileName out
                 )
      >>= B.writeFile out )

  L.map ((build </> "notes" </> img) </>) pngs |%> \out ->
    copyFile' (tmp_interleavings_1d </> "img" </> takeFileName out) out

  cl_get_mpl_rel_paths <- newCache $ \_ -> do
    need mpl_script_paths
    liftIO $ createDirectoryIfMissing True mpl
    pdfs <- getDirectoryFiles mpl ["*.pdf"]
    return $ L.map ("mpl" </>) pdfs

  let get_mpl_rel_paths = cl_get_mpl_rel_paths ()
  
  action $ do
    mpl_rel_paths <- get_mpl_rel_paths
    need $
      L.map ( ((build </> "notes" </> img) </>) . dropExtension ) mpl_rel_paths

  want $ L.map ((build </> "notes" </> img) </>) $ ("mpl" </> ".htaccess"):pngs

  build </> "notes" </> img </> "mpl" </> ".htaccess" %> \out ->
    copyFile' (img </> "mpl-htaccess") out

  build </> "notes" </> img </> "mpl" </> "*" %> \out -> do
    let pdf = mpl </> takeFileName out <.> "pdf"
    need [pdf]
    cmd "pdf2svg" pdf out

  fst $ MR.makeRules def { MR.tmpDir = Just tmp_interleavings_1d
                         , MR.mb_template = Just $
                                            template
                                            "notes/interleavings-1d"
                                            Nothing
                         , MR.mb_struct_file = Just $ MR.Input "struct.yaml"
                         , MR.ac_tex_deps = do
                             mpl_rel_paths <- get_mpl_rel_paths
                             return $ L.map ("img" </>) (
                               pngs ++ mpl_rel_paths
                               )
                         } interleavings_1d ( build </> "notes" )