module Darcs.UI.Options.Iso where

import Darcs.Prelude

-- * Isomorphisms

-- | Lightweight type ismomorphisms (a.k.a. invertible functions). If
-- 
-- > Iso fw bw :: Iso a b
--
-- then @fw@ and @bw@ are supposed to satisfy
--
-- prop> fw . bw = id = bw . fw
data Iso a b = Iso (a -> b) (b -> a)

-- | Lift an isomorphism between @a@ and @b@ to one between @f a@ and @f b@.
-- Like 'Functor', except we can only map invertible functions (i.e. an
-- Isomorphisms).
class IsoFunctor f where
  imap :: Iso a b -> f a -> f b

-- | Apply an iso under a functor.
under :: Functor f => Iso a b -> Iso (f a) (f b)
under :: Iso a b -> Iso (f a) (f b)
under (Iso a -> b
fw b -> a
bw) = (f a -> f b) -> (f b -> f a) -> Iso (f a) (f b)
forall a b. (a -> b) -> (b -> a) -> Iso a b
Iso ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
fw) ((b -> a) -> f b -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
bw)

-- | Apply an iso under cps (which is a cofunctor).
cps :: Iso a b -> Iso (a -> c) (b -> c)
cps :: Iso a b -> Iso (a -> c) (b -> c)
cps (Iso a -> b
fw b -> a
bw) = ((a -> c) -> b -> c)
-> ((b -> c) -> a -> c) -> Iso (a -> c) (b -> c)
forall a b. (a -> b) -> (b -> a) -> Iso a b
Iso (\a -> c
k -> a -> c
k (a -> c) -> (b -> a) -> b -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
bw) (\b -> c
k -> b -> c
k (b -> c) -> (a -> b) -> a -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
fw)