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