{- - Copyright (C) 2023 University of Luxembourg - - Licensed under the Apache License, Version 2.0 (the "License"); you may not - use this file except in compliance with the License. You may obtain a copy - of the License from the LICENSE file in this repository, or at: - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, WITHOUT - WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. See the - License for the specific language governing permissions and limitations - under the License. -} {-# LANGUAGE OverloadedStrings #-} module Utils where import Control.Monad.IO.Class import Data.List.Extra (stripSuffix) import Data.Maybe (isJust) import qualified Data.Text as T import Text.Pandoc.Definition import qualified Text.Pandoc.Walk import Types -- | A shortcut for `liftIO`. io :: MonadIO m => IO a -> m a io = liftIO -- | A helper for throwing an error if something is `Nothing` just :: String -> Maybe a -> a just _ (Just val) = val just err Nothing = error ("Missing: " ++ err) -- | Test for whether something listy has a suffix hasSuffix :: Eq a => [a] -> [a] -> Bool hasSuffix s = isJust . stripSuffix s -- | The same second as from arrows et al. second :: (a -> b) -> (c, a) -> (c, b) second f (a, b) = (a, f b) -- | A pandoc walker for modifying the URLs. walkURLs :: (FilePath -> Site FilePath) -> Text.Pandoc.Definition.Pandoc -> Site Text.Pandoc.Definition.Pandoc walkURLs f = Text.Pandoc.Walk.walkM go where go (Link a i (u, t)) = do u' <- T.pack <$> f (T.unpack u) pure $ Link a i (u', t) go (Image a i (u, t)) = do u' <- T.pack <$> f (T.unpack u) pure $ Image a i (u', t) go x = pure x -- | A pandoc walker for adding the local links to the headings (links are -- appended and get a given class) addHeadingLinks :: T.Text -> Text.Pandoc.Definition.Pandoc -> Text.Pandoc.Definition.Pandoc addHeadingLinks cls = Text.Pandoc.Walk.walk go where go h@(Header lvl attr@(id, _, _) inlines) = Header lvl attr (inlines ++ [Link ("", [cls], []) [Str "#"] ("#" <> id, "Link to this section")]) go x = x hasUriScheme :: String -> String -> Bool hasUriScheme x = all id . zipWith (==) x . (++ ":") unAbsolute :: String -> String unAbsolute = dropWhile (== '/') withPandocBlocks :: ([Block] -> [Block]) -> Pandoc -> Pandoc withPandocBlocks f (Pandoc meta blocks) = Pandoc meta (f blocks)