Currying.hs

{-# LANGUAGE MultiParamTypeClasses  #-}

{-| Module  : FiniteCategories
Description : Currying a functor @(A x B) -> C@ yields a functor @A -> [B,C]@.
Copyright   : Guillaume Sabbagh 2021
License     : GPL-3
Maintainer  : guillaumesabbagh@protonmail.com
Stability   : experimental
Portability : portable

Currying a functor @(A x B) -> C@ yields a functor @A -> [B,C]@.
-}
module Currying.Currying
(
curryDiagram,
uncurryDiagram,
switchArg,
)
where
    import FiniteCategory.FiniteCategory
    import ProductCategory.ProductCategory
    import FunctorCategory.FunctorCategory
    import Diagram.Diagram
    import Utils.AssociationList
    
    -- | Curry a functor @D : A x B -> C@ into a functor @D' : A -> [B,C]@.
    curryDiagram :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
                     FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2,
                     FiniteCategory c3 m3 o3, Morphism m3 o3) =>
                     Diagram (ProductCategory c1 m1 o1 c2 m2 o2) (ProductMorphism m1 o1 m2 o2) (ProductObject o1 o2) c3 m3 o3 -> Diagram c1 m1 o1 (FunctorCategory c2 m2 o2 c3 m3 o3) (NaturalTransformation c2 m2 o2 c3 m3 o3) (Diagram c2 m2 o2 c3 m3 o3)
    curryDiagram diag = Diagram{ 
                            src = (firstCategory (src diag)),
                            tgt = FunctorCategory{ sourceCat = (secondCategory (src diag)), targetCat = (tgt diag)},
                            omap = [(a, diagFromA a) | a <- ob (firstCategory (src diag))],
                            mmap = [(f, natFromF f) | f <- arrows (firstCategory (src diag))]
                        }
        where
            diagFromA a = Diagram{
                            src = (secondCategory (src diag)),
                            tgt = (tgt diag),
                            omap = [ (b, (omap diag) !-! (ProductObject a b) ) | b <- ob (secondCategory (src diag))],
                            mmap = [ (g, (mmap diag) !-! (ProductMorphism (identity (firstCategory (src diag)) a) g) ) | g <- arrows (secondCategory (src diag))]
                          }
            natFromF f = NaturalTransformation{
                            srcNT = (diagFromA (source f)),
                            tgtNT = (diagFromA (target f)),
                            component = (\b -> (mmap diag) !-! (ProductMorphism f (identity (secondCategory (src diag)) b)))
                        }
    
    -- | Uncurry a functor @D : A -> [B,C]@ into a functor @D' : A x B -> C@.
    uncurryDiagram :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
                     FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2,
                     FiniteCategory c3 m3 o3, Morphism m3 o3) =>
                     Diagram c1 m1 o1 (FunctorCategory c2 m2 o2 c3 m3 o3) (NaturalTransformation c2 m2 o2 c3 m3 o3) (Diagram c2 m2 o2 c3 m3 o3) -> Diagram (ProductCategory c1 m1 o1 c2 m2 o2) (ProductMorphism m1 o1 m2 o2) (ProductObject o1 o2) c3 m3 o3
    uncurryDiagram diag = Diagram{ src = ProductCategory (src diag) (sourceCat.tgt $ diag),
                                 tgt = (targetCat.tgt $ diag),
                                 omap = [(ProductObject a b, (omap ((omap diag) !-! a)) !-! b ) | a <- (ob (src diag)), b <- (ob (sourceCat.tgt $ diag))],
                                 mmap = [(ProductMorphism f g, ((mmap ((omap diag) !-! (target f))) !-! g) @ ((component ((mmap diag) !-! f)) (source g)) ) | f <- (arrows (src diag)), g <- (arrows (sourceCat.tgt $ diag))]
        }
        
    -- | Switches argument of a diagram @D : A x B -> C@ to create a diagram @D' : B x A -> C@.
    switch ::  (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
                FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2,
                FiniteCategory c3 m3 o3, Morphism m3 o3) =>
                Diagram (ProductCategory c1 m1 o1 c2 m2 o2) (ProductMorphism m1 o1 m2 o2) (ProductObject o1 o2) c3 m3 o3 -> Diagram (ProductCategory c2 m2 o2 c1 m1 o1) (ProductMorphism m2 o2 m1 o1) (ProductObject o2 o1) c3 m3 o3
    switch diag = Diagram {
                    src = (ProductCategory (secondCategory.src $ diag) (firstCategory.src $ diag)),
                    tgt = (tgt diag),
                    omap = [((ProductObject b a), (omap diag) !-! o) | o@(ProductObject a b) <- (ob.src $ diag)],
                    mmap = [((ProductMorphism b a), (mmap diag) !-! o) | o@(ProductMorphism a b) <- (arrows.src $ diag)]
        }
        
    -- | Switches argument of a curried diagram.
    switchArg :: (FiniteCategory c1 m1 o1, Morphism m1 o1, Eq m1, Eq o1,
                  FiniteCategory c2 m2 o2, Morphism m2 o2, Eq m2, Eq o2,
                  FiniteCategory c3 m3 o3, Morphism m3 o3) =>
                  Diagram c1 m1 o1 (FunctorCategory c2 m2 o2 c3 m3 o3) (NaturalTransformation c2 m2 o2 c3 m3 o3) (Diagram c2 m2 o2 c3 m3 o3) -> Diagram c2 m2 o2 (FunctorCategory c1 m1 o1 c3 m3 o3) (NaturalTransformation c1 m1 o1 c3 m3 o3) (Diagram c1 m1 o1 c3 m3 o3)
    switchArg = curryDiagram.switch.uncurryDiagram