@@ -1,3 +1,5 @@
1+{-# LANGUAGE TypeFamilies #-}
2+{-# LANGUAGE PatternSynonyms #-}
13{- |
24Module : Data.SemiIsoFunctor
35Description : Functors from the category of semi-isomoprihsms to Hask.
@@ -18,10 +20,13 @@ module Data.SemiIsoFunctor where
1820
1921import Control.Lens.Cons
2022import Control.Lens.Empty
23+import Control.Lens.Internal.SemiIso
2124import Control.Lens.SemiIso
25+import Data.Functor.Identity
26+import Data.Tuple.Morph
2227
2328infixl 3 /|/
24−infixl 4 /$/
29+infixl 4 /$/, ~$/, /$~, ~$~
2530infixl 5 /*/, /*, */
2631infixl 1 //=
2732infixr 1 =//
@@ -54,6 +59,30 @@ class SemiIsoFunctor f where
5459(/$/) :: SemiIsoFunctor f => ASemiIso' a b -> f b -> f a
5560(/$/) = simap
5661
62+-- | @ai /$~ f@ is equal to @ai . morphed /$/ f@.
63+--
64+-- This operator handles all the hairy stuff with uncurried application:
65+-- it reassociates the argument tuple and removes unnecessary (or adds necessary)
66+-- units to match the function type. You don't have to use /* and */ with this
67+-- operator.
68+(/$~) :: (SemiIsoFunctor f, HFoldable b', HFoldable b,
69+ HUnfoldable b', HUnfoldable b, Rep b' ~ Rep b)
70+ => ASemiIso' a b' -> f b -> f a
71+(SemiIso f g) /$~ h = semiIso f g . morphed /$/ h
72+
73+-- | @ai ~$/ f@ is equal to @morphed . ai /$/ f@.
74+(~$/) :: (SemiIsoFunctor f, HFoldable a', HFoldable a,
75+ HUnfoldable a', HUnfoldable a, Rep a' ~ Rep a)
76+ => ASemiIso' a' b -> f b -> f a
77+(SemiIso f g) ~$/ h = morphed . semiIso f g /$/ h
78+
79+-- | @ai ~$~ f@ is equal to @morphed . ai . morphed /$/ f@.
80+(~$~) :: (SemiIsoFunctor f, HFoldable b', HFoldable b', HFoldable b,
81+ HFoldable a, HUnfoldable b', HUnfoldable b', HUnfoldable b,
82+ HUnfoldable a, Rep b' ~ Rep b, Rep b' ~ Rep a)
83+ => ASemiIso b' b' b' b' -> f b -> f a
84+(SemiIso f g) ~$~ h = morphed . semiIso f g . morphed /$/ h
85+
5786-- | Equivalent of 'Applicative' for 'SemiIsoFunctor'.
5887--
5988-- However, this class implements uncurried application, unlike