allow adding full paths to .../index.html files, fix minor extra stuff

This commit is contained in:
Mirek Kratochvil 2023-07-21 20:32:51 +02:00
parent 4303d67cbc
commit 9834ea90dd
4 changed files with 24 additions and 15 deletions

View file

@ -13,7 +13,6 @@
- License for the specific language governing permissions and limitations - License for the specific language governing permissions and limitations
- under the License. - under the License.
-} -}
module FormatOpts where module FormatOpts where
import Text.Pandoc.Extensions import Text.Pandoc.Extensions

View file

@ -13,7 +13,6 @@
- License for the specific language governing permissions and limitations - License for the specific language governing permissions and limitations
- under the License. - under the License.
-} -}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
@ -76,6 +75,7 @@ data SiteState =
, _listTemplate :: FilePath -- ^ Name of the template for listing pages , _listTemplate :: FilePath -- ^ Name of the template for listing pages
, _timestampSuffix :: FilePath -- ^ File to search for a timestamp (e.g., if the prefix is ".ts", a timestamp for file "page.md" will be looked for in "page.md.ts"). These are best autogenerated with a script that sources the data from git or so. , _timestampSuffix :: FilePath -- ^ File to search for a timestamp (e.g., if the prefix is ".ts", a timestamp for file "page.md" will be looked for in "page.md.ts"). These are best autogenerated with a script that sources the data from git or so.
, _urlBase :: FilePath -- ^ "Root route" to prepend to all absolute links. , _urlBase :: FilePath -- ^ "Root route" to prepend to all absolute links.
, _appendUrlIndex :: Bool -- ^ Append full @index.html@ to all page URLs
, _dumpFinalState :: Bool -- ^ Triggers printing out the structure when the processing finishes. , _dumpFinalState :: Bool -- ^ Triggers printing out the structure when the processing finishes.
} }
deriving (Show) deriving (Show)
@ -141,15 +141,20 @@ siteOptions' = do
long "list-template" <> long "list-template" <>
help "Template for making tag-listing pages" <> help "Template for making tag-listing pages" <>
value "list.html" <> showDefault value "list.html" <> showDefault
_urlBase <-
strOption $
long "url-base" <>
short 'u' <> help "Base absolute URL" <> value "/" <> showDefault
_timestampSuffix <- _timestampSuffix <-
strOption $ strOption $
long "timestamp-prefix" <> long "timestamp-prefix" <>
help "Timestamp file suffix for markdowns" <> help "Timestamp file suffix for markdowns" <>
value ".timestamp" <> showDefault value ".timestamp" <> showDefault
_urlBase <-
strOption $
long "url-base" <>
short 'u' <> help "Base absolute URL" <> value "/" <> showDefault
_appendUrlIndex <-
switch $
long "append-url-index" <>
help
"Append 'index.html' to all urls, negating server problems with directory index settings."
_dumpFinalState <- _dumpFinalState <-
switch $ switch $
long "dump-state" <> long "dump-state" <>
@ -173,5 +178,5 @@ siteOptions =
info info
(siteOptions' <**> helper) (siteOptions' <**> helper)
(fullDesc <> (fullDesc <>
progDesc "Build a R3 Cards-like site" <> progDesc "Build a R3 static site" <>
header "site - the R3 site builder") header "reploy - the R3 static site builder")

View file

@ -13,7 +13,6 @@
- License for the specific language governing permissions and limitations - License for the specific language governing permissions and limitations
- under the License. - under the License.
-} -}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Utils where module Utils where

View file

@ -13,7 +13,6 @@
- License for the specific language governing permissions and limitations - License for the specific language governing permissions and limitations
- under the License. - under the License.
-} -}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
-- | The main deployment script. -- | The main deployment script.
@ -25,6 +24,7 @@ import Control.Monad.Trans.State.Lazy
import qualified Data.Aeson as AE import qualified Data.Aeson as AE
import qualified Data.Aeson.Key as K import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as KM import qualified Data.Aeson.KeyMap as KM
import Data.Bool (bool)
import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy as B
import Data.Digest.Pure.SHA (sha256, showDigest) import Data.Digest.Pure.SHA (sha256, showDigest)
import Data.Foldable (traverse_) import Data.Foldable (traverse_)
@ -161,6 +161,12 @@ checkTarget fp = do
rootUrl :: FilePath -> Site FilePath rootUrl :: FilePath -> Site FilePath
rootUrl fp = (</> unAbsolute fp) <$> use urlBase rootUrl fp = (</> unAbsolute fp) <$> use urlBase
-- | Like `rootUrl` but also appends @index.html@ for systems that don't have
-- working directory indexes.
rootPageUrl :: FilePath -> Site FilePath
rootPageUrl fp =
bool id (</> "index.html") <$> use appendUrlIndex <*> rootUrl fp
-- | Process a single link pointing out from a page. -- | Process a single link pointing out from a page.
processLink :: FilePath -> FilePath -> Site String processLink :: FilePath -> FilePath -> Site String
processLink base l = processLink base l =
@ -168,7 +174,7 @@ processLink base l =
"#" "#"
then pure l then pure l
else if isAbsolute l else if isAbsolute l
then rootUrl l then rootPageUrl l
else installFile (base </> l) >>= rootUrl else installFile (base </> l) >>= rootUrl
-- | Get a mount point of the page into the correct location. -- | Get a mount point of the page into the correct location.
@ -401,7 +407,7 @@ tagPath = joinPath
-- | Make a link to the tag page -- | Make a link to the tag page
tagLink :: [String] -> Site FilePath tagLink :: [String] -> Site FilePath
tagLink = rootUrl . ("tag" </>) . tagPath tagLink = rootPageUrl . ("tag" </>) . tagPath
-- | Fold the hierarchical tag bits to a slashed path. -- | Fold the hierarchical tag bits to a slashed path.
listPath :: [String] -> FilePath listPath :: [String] -> FilePath
@ -409,7 +415,7 @@ listPath = joinPath
-- | Make a link to the tag page -- | Make a link to the tag page
listLink :: [String] -> Site FilePath listLink :: [String] -> Site FilePath
listLink = rootUrl . ("list" </>) . listPath listLink = rootPageUrl . ("list" </>) . listPath
-- | Make metadata for printing out a single hierarchical tag (all levels clickable) -- | Make metadata for printing out a single hierarchical tag (all levels clickable)
makeHTagMeta :: ([String] -> Site FilePath) -> [String] -> Site Y.Value makeHTagMeta :: ([String] -> Site FilePath) -> [String] -> Site Y.Value
@ -425,7 +431,7 @@ makeHTagMeta lf tag = do
-- | Make metadata for printing out a link to a page -- | Make metadata for printing out a link to a page
makePageLinkMeta :: FilePath -> Site Y.Value makePageLinkMeta :: FilePath -> Site Y.Value
makePageLinkMeta mount = do makePageLinkMeta mount = do
link <- rootUrl mount link <- rootPageUrl mount
meta <- use $ pages . to (M.! mount) . pageMeta meta <- use $ pages . to (M.! mount) . pageMeta
pure $ Y.object [("href", fromString link), ("meta", meta)] pure $ Y.object [("href", fromString link), ("meta", meta)]
@ -517,7 +523,7 @@ renderLists = use (ehtags . to M.keys) >>= traverse_ renderList
-- | Transform one mounted PageInfo to the base search data -- | Transform one mounted PageInfo to the base search data
mkSearchData :: FilePath -> PageInfo -> Site [Y.Value] mkSearchData :: FilePath -> PageInfo -> Site [Y.Value]
mkSearchData mount pi = do mkSearchData mount pi = do
link <- rootUrl mount link <- rootPageUrl mount
text <- io . runIOorExplode $ writePlain plainWriteOpts (pi ^. pageDoc) text <- io . runIOorExplode $ writePlain plainWriteOpts (pi ^. pageDoc)
let title = pi ^? pageMeta . key "title" . _String let title = pi ^? pageMeta . key "title" . _String
-- TODO: unify retrieval of tags -- TODO: unify retrieval of tags