Fixing templates + aliases

1 files changed, 42 insertions, 0 deletions

diff --git a/src/Hakyll/Alias.hs b/src/Hakyll/Alias.hs
new file mode 100644
index 0000000..b127a05
--- /dev/null
+++ b/src/Hakyll/Alias.hs
@@ -0,0 +1,42 @@
+module Hakyll.Alias where
+
+import Prolog
+import Data.HashSet qualified as HS
+
+
+newtype Aliased a x = Aliased { unAliased :: Either a x }
+    deriving newtype (Binary, Eq, Foldable, Functor, Generic, Generic1, Hashable, Ord, Show, Traversable)
+
+class (Eq a, Hashable a) => ToAliases x a where
+    toAliases :: x -> HashSet a
+
+instance Hashable a => ToAliases a a where
+    toAliases = HM.singleton
+
+instance (Eq a, Hashable a) => ToAliases (HashSet a) a where
+    toAliases = id
+
+instance ToAliases x a => ToAliases [x] a where
+    toAliases = foldMap toAliases
+
+
+class FromAlias a x where
+    fromAlias :: MonadThrow m => a -> m x
+
+instance FromAlias a a where
+    fromAlias = pure
+
+instance (FromAlias a x, FromAlias b x) => FromAlias (Either a b) x where
+    fromAlias = either fromAlias fromAlias
+
+instance FromAlias a x => FromAlias (Aliased a x) x where
+    fromAlias = fromAlias . unAliased
+
+newtype NoAlias a =NoAlias a
+    deriving (Eq, Show)
+
+instance Show a => Exception (NoAlias a) where
+    displayException (NoAlias a) = show a <> " is not an alias"
+
+missingAlias :: MonadThrow m => a -> m b
+missingAlias = throwM . NoAlias