blog/blog-meta/lib/Misc.hs
rhiannon morris be46a2fc5c fix tags with spaces
add a filter that replaces tags e.g.
"tag name" → {name: "tag name", slug: "tag_name"}
2022-09-17 20:54:16 +02:00

57 lines
1.8 KiB
Haskell

module Misc where
import qualified System.Console.GetOpt as GetOpt
import System.Environment
import System.Exit
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Char (isAlphaNum, isAscii, toLower)
import Text.Pandoc.Definition
-- | exception on 'Left'
unwrap :: Show a => FilePath -> Either a b -> IO b
unwrap file = either (\x -> fail $ file <> ":" <> show x) return
getOptionsWith :: (String -> String) -> ([String] -> Maybe a)
-> [GetOpt.OptDescr (a -> a)] -> IO a
getOptionsWith hdr mkDef descrs = do
res <- GetOpt.getOpt GetOpt.Permute descrs <$> getArgs
case res of
(fs, rest, []) | Just def <- mkDef rest ->
return $ foldl (flip ($)) def fs
_ -> do
prog <- getProgName
putStrLn $ GetOpt.usageInfo (hdr prog) descrs
exitFailure
makeSlug :: Text -> Text
makeSlug name = Text.map toSlugChar name where
toSlugChar c
| isAlphaNum c && isAscii c || c == '-' = toLower c
| otherwise = '_'
toTextList :: MetaValue -> Maybe [Text]
toTextList (MetaList vs) = traverse toText vs
toTextList _ = Nothing
toText :: MetaValue -> Maybe Text
toText (MetaString str) = Just str
toText (MetaInlines is) = foldMap inlineText is
toText (MetaBlocks bs) = foldMap blockText bs
toText _ = Nothing
inlineText :: Inline -> Maybe Text
inlineText (Str txt) = Just txt
inlineText Space = Just " "
inlineText SoftBreak = Just " "
inlineText LineBreak = Just " "
inlineText (RawInline _ txt) = Just txt
inlineText _ = Nothing
blockText :: Block -> Maybe Text
blockText (Plain is) = foldMap inlineText is
blockText (Para is) = foldMap inlineText is
blockText Null = Just ""
blockText (RawBlock _ txt) = Just txt
blockText _ = Nothing