{-# LANGUAGE Safe #-}
-- | A 'Foldable' instance for functions, given the input is 'Finite', and
-- a 'Traversable' instance for functions, given the input is 'Ord' and
-- 'Finite'.
module Data.Universe.Instances.Traversable () where

import Control.Applicative
import Data.Foldable
import Data.Map ((!), fromList)
import Data.Monoid
import Data.Traversable
import Data.Universe.Class

instance Finite e => Foldable ((->) e) where
  foldMap :: forall m a. Monoid m => (a -> m) -> (e -> a) -> m
foldMap a -> m
f e -> a
g = [m] -> m
forall a. Monoid a => [a] -> a
mconcat ([m] -> m) -> [m] -> m
forall a b. (a -> b) -> a -> b
$ (e -> m) -> [e] -> [m]
forall a b. (a -> b) -> [a] -> [b]
map (a -> m
f (a -> m) -> (e -> a) -> e -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> a
g) [e]
forall a. Finite a => [a]
universeF

instance (Ord e, Finite e) => Traversable ((->) e) where
  sequenceA :: forall (f :: * -> *) a. Applicative f => (e -> f a) -> f (e -> a)
sequenceA e -> f a
f = Map e a -> e -> a
forall k a. Ord k => Map k a -> k -> a
(!) (Map e a -> e -> a) -> ([(e, a)] -> Map e a) -> [(e, a)] -> e -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(e, a)] -> Map e a
forall k a. Ord k => [(k, a)] -> Map k a
fromList ([(e, a)] -> e -> a) -> f [(e, a)] -> f (e -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [f (e, a)] -> f [(e, a)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [(,) e
x (a -> (e, a)) -> f a -> f (e, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> e -> f a
f e
x | e
x <- [e]
forall a. Finite a => [a]
universeF]