From 4c1f0f9a4e4ee68aab098a61d3749960f568ec7f Mon Sep 17 00:00:00 2001
From: Mirek Kratochvil <miroslav.kratochvil@uni.lu>
Date: Thu, 8 Jun 2023 13:51:30 +0200
Subject: install files properly

---
 site.hs | 33 ++++++++++++++++-----------------
 1 file changed, 16 insertions(+), 17 deletions(-)

(limited to 'site.hs')

diff --git a/site.hs b/site.hs
index dafe23f..affb61d 100644
--- a/site.hs
+++ b/site.hs
@@ -4,6 +4,7 @@
 module Main where
 
 import Control.Monad ((>=>), unless, when)
+import Control.Monad.Extra (whenM)
 import Control.Monad.Trans.State.Lazy
 import qualified Data.Aeson.KeyMap as KM
 import qualified Data.ByteString.Lazy as B
@@ -27,6 +28,7 @@ import System.FilePath
   , isAbsolute
   , splitDirectories
   , splitPath
+  , takeDirectory
   , takeFileName
   )
 import qualified Text.Mustache as Mu
@@ -41,11 +43,11 @@ import Utils
 
 -- | Load the pages from a directory and add them to `pages`.
 sourcePages :: FilePath -> Site ()
-sourcePages fp = do
-  links <-
-    io $ filter (hasSuffix ".md" . last . splitPath) <$>
-    getRecursiveContents (pure . const False) fp
-  traverse_ loadPage (map (fp </>) links)
+sourcePages fp =
+  io
+    (map (fp </>) . filter (hasSuffix ".md" . last . splitPath) <$>
+     getRecursiveContents (pure . const False) fp) >>=
+  traverse_ loadPage
 
 {- | Extract `PageInfo` about a single page and save it into `pages` in
  - `SiteState`. -}
@@ -122,18 +124,17 @@ checkTarget fp = do
 
 -- | Prepend the root path to the given link
 rootUrl :: FilePath -> Site FilePath
-rootUrl = pure . ('/' :)
+rootUrl fp = (</> fp) <$> use urlBase
 
 -- | Process a single link pointing out from a page.
-processLink :: FilePath -> String -> Site String
-processLink base l = do
+processLink :: FilePath -> FilePath -> Site String
+processLink base l =
   if isAbsolute l
-    then pure l -- TODO prepend the root url
-    else (do io . putStrLn $ "rel:" ++ l
-             pure $ '/' : (base </> l) -- TODO
-          )
+    then rootUrl l
+    else installFile (base </> l) >>= rootUrl
 
 -- | Get a mount point of the page into the correct location.
+-- (Pages are currently mounted just to the root.)
 pageFilename :: FilePath -> Site FilePath
 pageFilename = indexFilename
 
@@ -151,7 +152,8 @@ installPage mount pi = do
   tname <- pageTemplate pi
   templ <- use $ templates . to (M.! fromString tname)
   file <- pageFilename mount
-  fixedUrlDoc <- walkURLs (processLink mount) $ pi ^. pageDoc
+  fixedUrlDoc <-
+    walkURLs (processLink $ pi ^. pagePath . to takeDirectory) $ pi ^. pageDoc
   checkTarget file
   io $ do
     putStrLn $ "P -> " ++ file
@@ -322,8 +324,5 @@ main =
     sourceTemplates "templates"
     use pages >>= traverse (uncurry installPage) . M.assocs
     renderTags
-    -- testing part begin
-    installFile "external/mypage/img/awesome.png"
-    -- testing part end
     io $ putStrLn "OK"
-    get >>= io . print
+    whenM (use dumpFinalState) $ get >>= io . print
-- 
cgit v1.2.3