From d315c17b89d333d54cb2c608b7d3b3dcacb95507 Mon Sep 17 00:00:00 2001
From: Chris Wells <chris@mathematicaster.org>
Date: Mon, 24 Mar 2025 15:09:25 -0500
Subject: Extra utils

---
 src/Hakyll/Alias.hs |  6 +++---
 src/Prolog.hs       | 34 ++++++++++++++++++++++++++++++++--
 2 files changed, 35 insertions(+), 5 deletions(-)

(limited to 'src')

diff --git a/src/Hakyll/Alias.hs b/src/Hakyll/Alias.hs
index 4284e3d..063ea2b 100644
--- a/src/Hakyll/Alias.hs
+++ b/src/Hakyll/Alias.hs
@@ -22,10 +22,10 @@ aliasCtxt name toa fromx amap = functionField1 name $ toa >=> flip resolveAlias
 
 
 personCtxt :: (StringConv StrictText s, Ord (Name s), ToMarkup s) => AliasMap (Name s) (Person s) -> Context a
-personCtxt = aliasCtxt "person" (fmap (fmap toSL) . parseName . toSL) (pure . toSL . personHtml)
+personCtxt = aliasCtxt "personA" (ffmap toSL . parseName . toSL) (pure . toSL . personHtml)
 
 licenseCtxt :: (StringConv String s, Ord s, ToMarkup s) => AliasMap s (License s) -> Context a
-licenseCtxt = aliasCtxt "license" (pure . toSL) (pure . toSL . licenseHtml)
+licenseCtxt = aliasCtxt "licenseA" (pure . toSL) (pure . toSL . licenseHtml)
 
 journalCtxt :: (StringConv String s, Ord s, ToMarkup s) => AliasMap s (Journal s) -> Context a
-journalCtxt = aliasCtxt "journal" (pure . toSL) (pure . toSL . journalHtml)
+journalCtxt = aliasCtxt "journalA" (pure . toSL) (pure . toSL . journalHtml)
diff --git a/src/Prolog.hs b/src/Prolog.hs
index 145f2d3..94a6eb6 100644
--- a/src/Prolog.hs
+++ b/src/Prolog.hs
@@ -43,7 +43,9 @@ module Prolog
     , renderTo
     , fromStringlike
     -- * Utils
+    , ffmap
     , (<<$>>)
+    , fffmap
     , (<<<$>>>)
     , (<<&>>)
     , (-->)
@@ -54,6 +56,9 @@ module Prolog
     , squashMaybe
     , throwEither
     , squashEither
+    , rebase
+    , rebaseWith
+    , rebaseWithM
     ) where
 
 import Control.Applicative
@@ -100,14 +105,26 @@ import Text.LaTeX.Packages.Hyperref qualified as LH
 type StrictText = T.Text
 type LazyText = TL.Text
 
+-- | 'fmap' over nested functors
+ffmap :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
+ffmap = fmap fmap fmap
+{-# INLINE ffmap #-}
+
+-- | Infix version of 'ffmap'
 (<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
 infixl 4 <<$>>
-(<<$>>) = fmap fmap fmap
+(<<$>>) = ffmap
 {-# INLINE (<<$>>) #-}
 
+-- | 'fmap' over nested functors
+fffmap ::  (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
+fffmap = fmap . fmap . fmap
+{-# INLINE fffmap #-}
+
+-- | Infix version of 'fffmap'
 (<<<$>>>) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
 infixl 4 <<<$>>>
-(<<<$>>>) = fmap . fmap . fmap
+(<<<$>>>) = fffmap
 {-# INLINE (<<<$>>>) #-}
 
 (<<&>>) :: (Functor f, Functor g) => f (g a) -> (a -> b) -> f (g b)
@@ -160,6 +177,19 @@ fromStringlike :: (IsString s, StringConv t String) => t -> s
 fromStringlike = fromString . toSL
 {-# INLINE fromStringlike #-}
 
+
+rebase :: (Applicative m, Comonad w) => w a -> m a
+rebase = rebaseWith id
+{-# INLINE rebase #-}
+
+rebaseWith :: (Applicative m, Comonad w) => (a -> b) -> w a -> m b
+rebaseWith f = rebaseWithM $ pure . f
+{-# INLINE rebaseWith #-}
+
+rebaseWithM :: (Applicative m, Comonad w) => (a -> m b) -> w a -> m b
+rebaseWithM f = f . extract
+{-# INLINE rebaseWithM #-}
+
 -- Orphan instances
 
 
-- 
cgit v1.2.3