tags get sourced

1 files changed, 45 insertions, 10 deletions

diff --git a/site.hs b/site.hs
index 8ab060f..2b489e9 100644
--- a/site.hs
+++ b/site.hs
@@ -3,13 +3,14 @@
 -- | The main deployment script.
 module Main where
 
-import Control.Monad (unless, when)
+import Control.Monad ((>=>), unless, when)
 import Control.Monad.Trans.State.Lazy
 import qualified Data.Aeson.KeyMap as KM
 import qualified Data.ByteString.Lazy as B
 import Data.Digest.Pure.SHA (sha256, showDigest)
 import Data.Foldable (traverse_)
-import Data.List (nub)
+import Data.List (inits, nub)
+import Data.List.Extra (groupSort)
 import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.String (fromString)
@@ -21,7 +22,7 @@ import Hakyll.Core.Util.File (getRecursiveContents, makeDirectories)
 import Lens.Micro
 import Lens.Micro.Aeson
 import Lens.Micro.Mtl
-import System.FilePath ((</>), splitPath, takeFileName)
+import System.FilePath ((</>), splitDirectories, splitPath, takeFileName)
 import qualified Text.Mustache as Mu
 import Text.Pandoc.Class (runIOorExplode)
 import Text.Pandoc.Readers.Markdown (readMarkdown)
@@ -139,8 +140,8 @@ installRedirect target from = do
 installPageRedirects :: FilePath -> PageInfo -> Site ()
 installPageRedirects target pi = do
   traverse_
-    (installRedirect target . T.unpack)
-    (pi ^.. pageMeta . key "redirects" . values . _String)
+    (installRedirect target)
+    (pi ^.. pageMeta . key "redirects" . values . _String . to T.unpack)
 
 -- | Install all redirects required by all pages.
 installRedirects :: Site ()
@@ -155,6 +156,12 @@ dataFilename hash basename = do
       loc = "data" </> h1 </> h2 </> basename
   pure (od </> loc, loc)
 
+-- | Copy a source file to the destination, making the necessary directories in the process.
+copy :: FilePath -> FilePath -> IO ()
+copy src dst = do
+  makeDirectories dst
+  B.readFile src >>= B.writeFile dst
+
 {- | Install a file. Files are installed into a single shared location. That
  - prevents file duplication and also gives a bit of control for where the
  - files reside and what are their names. -}
@@ -162,20 +169,46 @@ installFile :: FilePath -> Site FilePath
 installFile fp = do
   let basename = takeFileName fp
   hash <- showDigest . sha256 <$> io (B.readFile fp)
-  alreadyExists <- S.member hash <$> use installs
   (file, loc) <- dataFilename hash basename
+  alreadyExists <- S.member (hash, basename) <$> use installs
   unless alreadyExists $ do
-    installs %= S.insert hash
+    installs %= S.insert (hash, basename)
     checkTarget file
     io $ do
       putStrLn $ "F -> " ++ fp ++ " -> " ++ file
-      makeDirectories file
-      B.readFile fp >>= B.writeFile file
+      copy fp file
   pure loc
 
 -- | Simply copy a strictly named asset.
 installAsset :: FilePath -> Site ()
-installAsset fp = undefined
+installAsset fp = do
+  od <- use outputDir
+  ad <- use assetDir
+  let [src,dst] = map (</> fp) [ad,od]
+  checkTarget dst
+  io $ do
+    putStrLn $ "A -> " ++ src ++ " -> " ++ dst
+    copy src dst
+
+-- | Copy all files from asset directory.
+installAssets :: Site ()
+installAssets =
+  use assetDir >>=
+  (io . getRecursiveContents (pure . const False) >=> traverse_ installAsset)
+
+sourceTags :: Site ()
+sourceTags = do
+  sgat <-
+    map
+      (second $ map splitDirectories .
+       (^.. pageMeta . key "tags" . values . _String . to T.unpack)) .
+    M.assocs <$>
+    use pages
+  htags .= M.fromList (invTags sgat)
+
+invTags :: [(FilePath, [[String]])] -> [([String], [FilePath])]
+invTags x =
+  map (fmap nub) $ groupSort [(t, p) | (p, htl) <- x, ht <- htl, t <- inits ht]
 
 -- | Render a site for a given tag string.
 renderTag :: [String] -> Site ()
@@ -188,7 +221,9 @@ renderTags = undefined
 -- | Build the whole site.
 main =
   flip runStateT emptySiteState $ do
+    installAssets
     traverse sourcePages ["external"]
+    sourceTags
     sourceTemplates "templates"
     use pages >>= traverse (uncurry installPage) . M.assocs
     installRedirects