blog/blog-meta/lib/Misc.hs

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