fix filenames in post lists

This commit is contained in:
rhiannon morris 2021-07-25 14:48:08 +02:00
parent 3c17aa052b
commit 54aac9c35a
3 changed files with 13 additions and 9 deletions

View file

@ -19,6 +19,7 @@ common deps
bytestring ^>= 0.10.12.0, bytestring ^>= 0.10.12.0,
containers ^>= 0.6.4.1, containers ^>= 0.6.4.1,
filemanip, filemanip,
filepath ^>= 1.4.2.1,
pandoc-types ^>= 1.22, pandoc-types ^>= 1.22,
text ^>= 1.2.4.1, text ^>= 1.2.4.1,
time ^>= 1.9.3 time ^>= 1.9.3

View file

@ -6,18 +6,18 @@ import Data.Ord (comparing)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Data.Time import Data.Time
import Misc
import qualified YAML import qualified YAML
import YAML ((.:), (.!=), (##=)) import YAML ((.:), (.!=), (##=))
import qualified System.Console.GetOpt as GetOpt import qualified System.Console.GetOpt as GetOpt
import qualified System.FilePath.Find as Find import qualified System.FilePath.Find as Find
import Misc import qualified System.FilePath as Path
import Data.Char (toLower)
main :: IO () main :: IO ()
main = do main = do
Opts title dir tag out <- getOptions Opts title dir tag out <- getOptions
files <- Find.findL True (pure True) (Find.extension Find.==? ".md") dir files <- Find.findL True (pure True) (Find.extension Find.==? ".md") dir
infos <- filter (checkTag tag) <$> traverse getInfo files infos <- filter (checkTag tag) <$> traverse (getInfo dir) files
let content = makeContent title infos let content = makeContent title infos
case out of case out of
Nothing -> LazyBS.putStr content Nothing -> LazyBS.putStr content
@ -63,12 +63,14 @@ defOpts [dir, title] =
defOpts _ = Nothing defOpts _ = Nothing
getInfo :: FilePath -> IO PostInfo getInfo :: FilePath -> FilePath -> IO PostInfo
getInfo file = do getInfo dir file = do
yaml <- YAML.readHeader file yaml <- YAML.readHeader file
let dirs = Path.splitPath dir
let file' = Path.joinPath $ drop (length dirs) $ Path.splitPath file
unwrap file $ YAML.parseEither $ unwrap file $ YAML.parseEither $
yaml & YAML.withMap "title, date, tags" \m -> yaml & YAML.withMap "title, date, tags" \m ->
Info <$> return (Text.pack file) Info <$> pure file'
<*> m .: "title" <*> m .: "title"
<*> m .: "date" <*> m .: "date"
<*> m .: "tags" .!= [] <*> m .: "tags" .!= []
@ -76,7 +78,7 @@ getInfo file = do
-- | the front matter info we care about -- | the front matter info we care about
data PostInfo = data PostInfo =
Info { Info {
_nfoFile :: Text, _nfoFile :: FilePath,
_nfoTitle :: Text, _nfoTitle :: Text,
infoDate :: BlogDate, infoDate :: BlogDate,
infoTags :: [Text] infoTags :: [Text]
@ -87,7 +89,8 @@ instance YAML.ToYAML PostInfo where
[("date" ##= date), [("date" ##= date),
("title" ##= title), ("title" ##= title),
("tags" ##= tags), ("tags" ##= tags),
("file" ##= file)] ("file" ##= Text.pack (fixup file))]
where fixup f = Path.replaceExtension f "html"
newtype BlogDate = D Day deriving (Eq, Ord) newtype BlogDate = D Day deriving (Eq, Ord)

View file

@ -2,7 +2,7 @@
<ul> <ul>
$for(posts)$ $for(posts)$
<li> <li>
<a href=$it.file$.html>$it.title$</a> <a href=$it.file$>$it.title$</a>
($it.date$) ($it.date$)
$endfor$ $endfor$
</ul> </ul>