58 lines
1.8 KiB
Haskell
58 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
|