mirror of
https://github.com/ilyakooo0/semi-iso-optics.git
synced 2024-09-11 07:55:36 +03:00
Added 'morphed' semi-iso and /$~, ~$/, ~$~ operators.
This commit is contained in:
parent
93dab1bf8d
commit
b978d852ed
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
@ -58,6 +59,7 @@ module Control.Lens.SemiIso (
|
||||
unit,
|
||||
swapped,
|
||||
associated,
|
||||
morphed,
|
||||
constant,
|
||||
exact,
|
||||
|
||||
@ -99,6 +101,7 @@ import Data.Foldable
|
||||
import Data.Functor.Identity
|
||||
import Data.Profunctor.Exposed
|
||||
import Data.Traversable
|
||||
import Data.Tuple.Morph
|
||||
|
||||
-- | A semi-isomorphism is a partial isomorphism with weakened laws.
|
||||
--
|
||||
@ -157,6 +160,14 @@ unit = iso (, ()) fst
|
||||
associated :: Iso' (a, (b, c)) ((a, b), c)
|
||||
associated = iso (\(a, (b, c)) -> ((a, b), c)) (\((a, b), c) -> (a, (b, c)))
|
||||
|
||||
-- | An isomorphism between two arbitrary nested tuples, as long the contained
|
||||
-- types (ignoring units!) read from left to right are the same.
|
||||
--
|
||||
-- This is implemented using 'Data.Tuple.Morph.morph' from 'tuple-morph'.
|
||||
morphed :: (HFoldable a, HUnfoldable a, HFoldable b, HUnfoldable b, Rep a ~ Rep b)
|
||||
=> Iso' a b
|
||||
morphed = iso morph morph
|
||||
|
||||
-- | \-> Always returns the argument.
|
||||
--
|
||||
-- \<- Maps everything to a @()@.
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{- |
|
||||
Module : Data.SemiIsoFunctor
|
||||
Description : Functors from the category of semi-isomoprihsms to Hask.
|
||||
@ -18,10 +20,13 @@ module Data.SemiIsoFunctor where
|
||||
|
||||
import Control.Lens.Cons
|
||||
import Control.Lens.Empty
|
||||
import Control.Lens.Internal.SemiIso
|
||||
import Control.Lens.SemiIso
|
||||
import Data.Functor.Identity
|
||||
import Data.Tuple.Morph
|
||||
|
||||
infixl 3 /|/
|
||||
infixl 4 /$/
|
||||
infixl 4 /$/, ~$/, /$~, ~$~
|
||||
infixl 5 /*/, /*, */
|
||||
infixl 1 //=
|
||||
infixr 1 =//
|
||||
@ -54,6 +59,30 @@ class SemiIsoFunctor f where
|
||||
(/$/) :: SemiIsoFunctor f => ASemiIso' a b -> f b -> f a
|
||||
(/$/) = simap
|
||||
|
||||
-- | @ai /$~ f@ is equal to @ai . morphed /$/ f@.
|
||||
--
|
||||
-- This operator handles all the hairy stuff with uncurried application:
|
||||
-- it reassociates the argument tuple and removes unnecessary (or adds necessary)
|
||||
-- units to match the function type. You don't have to use /* and */ with this
|
||||
-- operator.
|
||||
(/$~) :: (SemiIsoFunctor f, HFoldable b', HFoldable b,
|
||||
HUnfoldable b', HUnfoldable b, Rep b' ~ Rep b)
|
||||
=> ASemiIso' a b' -> f b -> f a
|
||||
(SemiIso f g) /$~ h = semiIso f g . morphed /$/ h
|
||||
|
||||
-- | @ai ~$/ f@ is equal to @morphed . ai /$/ f@.
|
||||
(~$/) :: (SemiIsoFunctor f, HFoldable a', HFoldable a,
|
||||
HUnfoldable a', HUnfoldable a, Rep a' ~ Rep a)
|
||||
=> ASemiIso' a' b -> f b -> f a
|
||||
(SemiIso f g) ~$/ h = morphed . semiIso f g /$/ h
|
||||
|
||||
-- | @ai ~$~ f@ is equal to @morphed . ai . morphed /$/ f@.
|
||||
(~$~) :: (SemiIsoFunctor f, HFoldable b', HFoldable b', HFoldable b,
|
||||
HFoldable a, HUnfoldable b', HUnfoldable b', HUnfoldable b,
|
||||
HUnfoldable a, Rep b' ~ Rep b, Rep b' ~ Rep a)
|
||||
=> ASemiIso b' b' b' b' -> f b -> f a
|
||||
(SemiIso f g) ~$~ h = morphed . semiIso f g . morphed /$/ h
|
||||
|
||||
-- | Equivalent of 'Applicative' for 'SemiIsoFunctor'.
|
||||
--
|
||||
-- However, this class implements uncurried application, unlike
|
||||
|
@ -24,5 +24,6 @@ library
|
||||
Control.Lens.Internal.SemiIso
|
||||
Data.SemiIsoFunctor
|
||||
Data.Profunctor.Exposed
|
||||
build-depends: base >= 4 && < 5, profunctors, transformers, lens
|
||||
build-depends: base >= 4 && < 5, profunctors, transformers, lens, tuple-morph
|
||||
default-language: Haskell2010
|
||||
ghc-options: -Wall
|
||||
|
Loading…
Reference in New Issue
Block a user