provide a pageName lambda for templates
This commit is contained in:
		
							parent
							
								
									22cee7eeea
								
							
						
					
					
						commit
						b63146f517
					
				
							
								
								
									
										10
									
								
								reploy.hs
									
									
									
									
									
								
							
							
						
						
									
										10
									
								
								reploy.hs
									
									
									
									
									
								
							| 
						 | 
					@ -185,6 +185,14 @@ processLink base l =
 | 
				
			||||||
           then rootedPageLink l
 | 
					           then rootedPageLink l
 | 
				
			||||||
           else installFile (base </> l) >>= rootedLink
 | 
					           else installFile (base </> l) >>= rootedLink
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					-- | Conjure a function that finds a displayable name for a page at a particular mount.
 | 
				
			||||||
 | 
					pageName' :: Site (FilePath -> String)
 | 
				
			||||||
 | 
					pageName' = do
 | 
				
			||||||
 | 
					  ps <- use pages
 | 
				
			||||||
 | 
					  pure $ \mnt' ->
 | 
				
			||||||
 | 
					    just ("template looks for undefined page name : " ++ mnt')
 | 
				
			||||||
 | 
					      $  ps M.!? unAbsolute mnt' >>= (^? pageMeta . key "template" . _String . to T.unpack)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Like `Mu.substitute` but writes (and eventually should throw) stuff on errors
 | 
					-- | Like `Mu.substitute` but writes (and eventually should throw) stuff on errors
 | 
				
			||||||
checkedSubstitute :: Mu.Template -> MT.Value -> IO T.Text
 | 
					checkedSubstitute :: Mu.Template -> MT.Value -> IO T.Text
 | 
				
			||||||
checkedSubstitute t v = do
 | 
					checkedSubstitute t v = do
 | 
				
			||||||
| 
						 | 
					@ -199,6 +207,7 @@ addGlobalMeta meta = do
 | 
				
			||||||
  r <- use urlBase
 | 
					  r <- use urlBase
 | 
				
			||||||
  rt <- rootedLink'
 | 
					  rt <- rootedLink'
 | 
				
			||||||
  rtp <- rootedPageLink'
 | 
					  rtp <- rootedPageLink'
 | 
				
			||||||
 | 
					  pn <- pageName'
 | 
				
			||||||
  Y.Object m <- (`objMerge` meta) <$> use extraMeta
 | 
					  Y.Object m <- (`objMerge` meta) <$> use extraMeta
 | 
				
			||||||
  let l = map (\(k, v) -> (K.toText k, Mu.toMustache v)) $ KM.toList m
 | 
					  let l = map (\(k, v) -> (K.toText k, Mu.toMustache v)) $ KM.toList m
 | 
				
			||||||
  pure . Mu.object
 | 
					  pure . Mu.object
 | 
				
			||||||
| 
						 | 
					@ -206,6 +215,7 @@ addGlobalMeta meta = do
 | 
				
			||||||
        ++ [ ("root", Mu.toMustache $ T.pack r)
 | 
					        ++ [ ("root", Mu.toMustache $ T.pack r)
 | 
				
			||||||
           , ("rawRootUrl", Mu.overText $ T.pack . rt . T.unpack)
 | 
					           , ("rawRootUrl", Mu.overText $ T.pack . rt . T.unpack)
 | 
				
			||||||
           , ("pageLink", Mu.overText $ T.pack . rtp . T.unpack)
 | 
					           , ("pageLink", Mu.overText $ T.pack . rtp . T.unpack)
 | 
				
			||||||
 | 
					           , ("pageName", Mu.overText $ T.pack . pn . T.unpack)
 | 
				
			||||||
           ]
 | 
					           ]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
-- | Get the expected timestamp file for a given filepath
 | 
					-- | Get the expected timestamp file for a given filepath
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in a new issue