allow adding full paths to .../index.html files, fix minor extra stuff
This commit is contained in:
parent
4303d67cbc
commit
9834ea90dd
|
@ -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
|
||||||
|
|
19
Types.hs
19
Types.hs
|
@ -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")
|
||||||
|
|
1
Utils.hs
1
Utils.hs
|
@ -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
|
||||||
|
|
18
reploy.hs
18
reploy.hs
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue