32 lines
1.1 KiB
Haskell
32 lines
1.1 KiB
Haskell
module Functor.Associative where
|
|
|
|
import Functor.Base
|
|
import Functor.Bifunctor
|
|
import Functor.Compose
|
|
import Relation
|
|
|
|
import Data.Either (Either (Left, Right))
|
|
import Data.Kind (Constraint)
|
|
|
|
type Associative :: (k -> k -> k) -> Constraint
|
|
class Bifunctor f => Associative f where
|
|
assocL :: Object (Cod1 f) x -> Object (Cod1 f) y -> Object (Cod1 f) z -> Cod1 f (f x (f y z)) (f (f x y) z)
|
|
assocR :: Object (Cod1 f) x -> Object (Cod1 f) y -> Object (Cod1 f) z -> Cod1 f (f (f x y) z) (f x (f y z))
|
|
|
|
instance Associative (,) where
|
|
assocL _ _ _ ~(x, ~(y, z)) = ((x, y), z)
|
|
assocR _ _ _ ~(~(x, y), z) = (x, (y, z))
|
|
|
|
instance Associative Either where
|
|
assocL _ _ _ (Left x) = Left (Left x)
|
|
assocL _ _ _ (Right (Left y)) = Left (Right y)
|
|
assocL _ _ _ (Right (Right z)) = Right z
|
|
|
|
assocR _ _ _ (Left (Left x)) = Left x
|
|
assocR _ _ _ (Left (Right y)) = Right (Left y)
|
|
assocR _ _ _ (Right z) = Right (Right z)
|
|
|
|
instance Associative Compose where
|
|
assocL (Nat _) (Nat _) (Nat _) = Nat \_ (Compose x) -> Compose (Compose (map getCompose x))
|
|
assocR (Nat _) (Nat _) (Nat _) = Nat \_ (Compose (Compose x)) -> Compose (map Compose x)
|