{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeOperators #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE EmptyCase #-}
#endif
module Data.Functor.Extend
(
Extend(..)
) where
import Prelude hiding (id, (.))
import Control.Category
import Control.Monad.Trans.Identity
import Data.Functor.Identity
import Data.Functor.Sum as Functor (Sum(..))
import Data.List (tails)
import Data.List.NonEmpty (NonEmpty(..), toList)
#ifdef MIN_VERSION_containers
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Tree
#endif
#ifdef MIN_VERSION_comonad
import Control.Comonad.Trans.Env
import Control.Comonad.Trans.Store
import Control.Comonad.Trans.Traced
#endif
#ifdef MIN_VERSION_tagged
import Data.Tagged
#endif
#if defined(MIN_VERSION_tagged) || MIN_VERSION_base(4,7,0)
import Data.Proxy
#endif
#ifdef MIN_VERSION_generic_deriving
import Generics.Deriving.Base as Generics
#else
import GHC.Generics as Generics
#endif
import Data.Orphans ()
import qualified Data.Monoid as Monoid
import Data.Semigroup as Semigroup
class Functor w => Extend w where
duplicated :: w a -> w (w a)
extended :: (w a -> b) -> w a -> w b
extended w a -> b
f = (w a -> b) -> w (w a) -> w b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap w a -> b
f (w (w a) -> w b) -> (w a -> w (w a)) -> w a -> w b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. w a -> w (w a)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated
duplicated = (w a -> w a) -> w a -> w (w a)
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended w a -> w a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
#if __GLASGOW_HASKELL__ >= 708
{-# MINIMAL duplicated | extended #-}
#endif
instance Extend [] where
duplicated :: [a] -> [[a]]
duplicated = [[a]] -> [[a]]
forall a. [a] -> [a]
init ([[a]] -> [[a]]) -> ([a] -> [[a]]) -> [a] -> [[a]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [a] -> [[a]]
forall a. [a] -> [[a]]
tails
#ifdef MIN_VERSION_tagged
instance Extend (Tagged a) where
duplicated :: Tagged a a -> Tagged a (Tagged a a)
duplicated = Tagged a a -> Tagged a (Tagged a a)
forall k (s :: k) b. b -> Tagged s b
Tagged
#endif
#if defined(MIN_VERSION_tagged) || MIN_VERSION_base(4,7,0)
instance Extend Proxy where
duplicated :: Proxy a -> Proxy (Proxy a)
duplicated Proxy a
_ = Proxy (Proxy a)
forall k (t :: k). Proxy t
Proxy
extended :: (Proxy a -> b) -> Proxy a -> Proxy b
extended Proxy a -> b
_ Proxy a
_ = Proxy b
forall k (t :: k). Proxy t
Proxy
#endif
instance Extend Maybe where
duplicated :: Maybe a -> Maybe (Maybe a)
duplicated Maybe a
Nothing = Maybe (Maybe a)
forall a. Maybe a
Nothing
duplicated Maybe a
j = Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
j
instance Extend (Either a) where
duplicated :: Either a a -> Either a (Either a a)
duplicated (Left a
a) = a -> Either a (Either a a)
forall a b. a -> Either a b
Left a
a
duplicated Either a a
r = Either a a -> Either a (Either a a)
forall a b. b -> Either a b
Right Either a a
r
instance Extend ((,)e) where
duplicated :: (e, a) -> (e, (e, a))
duplicated (e, a)
p = ((e, a) -> e
forall a b. (a, b) -> a
fst (e, a)
p, (e, a)
p)
instance Semigroup m => Extend ((->)m) where
duplicated :: (m -> a) -> m -> m -> a
duplicated m -> a
f m
m = m -> a
f (m -> a) -> (m -> m) -> m -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>) m
m
#ifdef MIN_VERSION_containers
instance Extend Seq where
duplicated :: Seq a -> Seq (Seq a)
duplicated Seq a
l = Int -> Seq (Seq a) -> Seq (Seq a)
forall a. Int -> Seq a -> Seq a
Seq.take (Seq a -> Int
forall a. Seq a -> Int
Seq.length Seq a
l) (Seq a -> Seq (Seq a)
forall a. Seq a -> Seq (Seq a)
Seq.tails Seq a
l)
instance Extend Tree where
duplicated :: Tree a -> Tree (Tree a)
duplicated w :: Tree a
w@(Node a
_ Forest a
as) = Tree a -> Forest (Tree a) -> Tree (Tree a)
forall a. a -> Forest a -> Tree a
Node Tree a
w ((Tree a -> Tree (Tree a)) -> Forest a -> Forest (Tree a)
forall a b. (a -> b) -> [a] -> [b]
map Tree a -> Tree (Tree a)
forall (w :: * -> *) a. Extend w => w a -> w (w a)
duplicated Forest a
as)
#endif
#ifdef MIN_VERSION_comonad
instance Extend w => Extend (EnvT e w) where
duplicated :: EnvT e w a -> EnvT e w (EnvT e w a)
duplicated (EnvT e
e w a
wa) = e -> w (EnvT e w a) -> EnvT e w (EnvT e w a)
forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT e
e ((w a -> EnvT e w a) -> w a -> w (EnvT e w a)
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (e -> w a -> EnvT e w a
forall e (w :: * -> *) a. e -> w a -> EnvT e w a
EnvT e
e) w a
wa)
instance Extend w => Extend (StoreT s w) where
duplicated :: StoreT s w a -> StoreT s w (StoreT s w a)
duplicated (StoreT w (s -> a)
wf s
s) = w (s -> StoreT s w a) -> s -> StoreT s w (StoreT s w a)
forall s (w :: * -> *) a. w (s -> a) -> s -> StoreT s w a
StoreT ((w (s -> a) -> s -> StoreT s w a)
-> w (s -> a) -> w (s -> StoreT s w a)
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended w (s -> a) -> s -> StoreT s w a
forall s (w :: * -> *) a. w (s -> a) -> s -> StoreT s w a
StoreT w (s -> a)
wf) s
s
extended :: (StoreT s w a -> b) -> StoreT s w a -> StoreT s w b
extended StoreT s w a -> b
f (StoreT w (s -> a)
wf s
s) = w (s -> b) -> s -> StoreT s w b
forall s (w :: * -> *) a. w (s -> a) -> s -> StoreT s w a
StoreT ((w (s -> a) -> s -> b) -> w (s -> a) -> w (s -> b)
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (\w (s -> a)
wf' s
s' -> StoreT s w a -> b
f (w (s -> a) -> s -> StoreT s w a
forall s (w :: * -> *) a. w (s -> a) -> s -> StoreT s w a
StoreT w (s -> a)
wf' s
s')) w (s -> a)
wf) s
s
instance (Extend w, Semigroup m) => Extend (TracedT m w) where
extended :: (TracedT m w a -> b) -> TracedT m w a -> TracedT m w b
extended TracedT m w a -> b
f = w (m -> b) -> TracedT m w b
forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT (w (m -> b) -> TracedT m w b)
-> (TracedT m w a -> w (m -> b)) -> TracedT m w a -> TracedT m w b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (w (m -> a) -> m -> b) -> w (m -> a) -> w (m -> b)
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (\w (m -> a)
wf m
m -> TracedT m w a -> b
f (w (m -> a) -> TracedT m w a
forall m (w :: * -> *) a. w (m -> a) -> TracedT m w a
TracedT (((m -> a) -> m -> a) -> w (m -> a) -> w (m -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((m -> a) -> (m -> m) -> m -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m -> m -> m
forall a. Semigroup a => a -> a -> a
(<>) m
m) w (m -> a)
wf))) (w (m -> a) -> w (m -> b))
-> (TracedT m w a -> w (m -> a)) -> TracedT m w a -> w (m -> b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TracedT m w a -> w (m -> a)
forall m (w :: * -> *) a. TracedT m w a -> w (m -> a)
runTracedT
#endif
instance Extend Identity where
duplicated :: Identity a -> Identity (Identity a)
duplicated = Identity a -> Identity (Identity a)
forall a. a -> Identity a
Identity
instance Extend w => Extend (IdentityT w) where
extended :: (IdentityT w a -> b) -> IdentityT w a -> IdentityT w b
extended IdentityT w a -> b
f (IdentityT w a
m) = w b -> IdentityT w b
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT ((w a -> b) -> w a -> w b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (IdentityT w a -> b
f (IdentityT w a -> b) -> (w a -> IdentityT w a) -> w a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. w a -> IdentityT w a
forall k (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT) w a
m)
instance Extend NonEmpty where
extended :: (NonEmpty a -> b) -> NonEmpty a -> NonEmpty b
extended NonEmpty a -> b
f w :: NonEmpty a
w@(~(a
_ :| [a]
aas)) =
NonEmpty a -> b
f NonEmpty a
w b -> [b] -> NonEmpty b
forall a. a -> [a] -> NonEmpty a
:| case [a]
aas of
[] -> []
(a
a:[a]
as) -> NonEmpty b -> [b]
forall a. NonEmpty a -> [a]
toList ((NonEmpty a -> b) -> NonEmpty a -> NonEmpty b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended NonEmpty a -> b
f (a
a a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
:| [a]
as))
instance (Extend f, Extend g) => Extend (Functor.Sum f g) where
extended :: (Sum f g a -> b) -> Sum f g a -> Sum f g b
extended Sum f g a -> b
f (InL f a
l) = f b -> Sum f g b
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL ((f a -> b) -> f a -> f b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (Sum f g a -> b
f (Sum f g a -> b) -> (f a -> Sum f g a) -> f a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f a -> Sum f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k). f a -> Sum f g a
InL) f a
l)
extended Sum f g a -> b
f (InR g a
r) = g b -> Sum f g b
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR ((g a -> b) -> g a -> g b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (Sum f g a -> b
f (Sum f g a -> b) -> (g a -> Sum f g a) -> g a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. g a -> Sum f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k). g a -> Sum f g a
InR) g a
r)
instance (Extend f, Extend g) => Extend (f :+: g) where
extended :: ((:+:) f g a -> b) -> (:+:) f g a -> (:+:) f g b
extended (:+:) f g a -> b
f (L1 f a
l) = f b -> (:+:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 ((f a -> b) -> f a -> f b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended ((:+:) f g a -> b
f ((:+:) f g a -> b) -> (f a -> (:+:) f g a) -> f a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1) f a
l)
extended (:+:) f g a -> b
f (R1 g a
r) = g b -> (:+:) f g b
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 ((g a -> b) -> g a -> g b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended ((:+:) f g a -> b
f ((:+:) f g a -> b) -> (g a -> (:+:) f g a) -> g a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. g a -> (:+:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1) g a
r)
instance Extend Generics.U1 where
extended :: (U1 a -> b) -> U1 a -> U1 b
extended U1 a -> b
_ U1 a
U1 = U1 b
forall k (p :: k). U1 p
U1
instance Extend Generics.V1 where
#if __GLASGOW_HASKELL__ >= 708
extended :: (V1 a -> b) -> V1 a -> V1 b
extended V1 a -> b
_ V1 a
e = case V1 a
e of {}
#else
extended _ e = seq e undefined
#endif
instance Extend f => Extend (Generics.M1 i t f) where
extended :: (M1 i t f a -> b) -> M1 i t f a -> M1 i t f b
extended M1 i t f a -> b
f = f b -> M1 i t f b
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f b -> M1 i t f b)
-> (M1 i t f a -> f b) -> M1 i t f a -> M1 i t f b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (f a -> b) -> f a -> f b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (M1 i t f a -> b
f (M1 i t f a -> b) -> (f a -> M1 i t f a) -> f a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f a -> M1 i t f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1) (f a -> f b) -> (M1 i t f a -> f a) -> M1 i t f a -> f b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. M1 i t f a -> f a
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1
instance Extend Par1 where
extended :: (Par1 a -> b) -> Par1 a -> Par1 b
extended Par1 a -> b
f w :: Par1 a
w@Par1{} = b -> Par1 b
forall p. p -> Par1 p
Par1 (Par1 a -> b
f Par1 a
w)
instance Extend f => Extend (Rec1 f) where
extended :: (Rec1 f a -> b) -> Rec1 f a -> Rec1 f b
extended Rec1 f a -> b
f = f b -> Rec1 f b
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 (f b -> Rec1 f b) -> (Rec1 f a -> f b) -> Rec1 f a -> Rec1 f b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (f a -> b) -> f a -> f b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (Rec1 f a -> b
f (Rec1 f a -> b) -> (f a -> Rec1 f a) -> f a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f a -> Rec1 f a
forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1) (f a -> f b) -> (Rec1 f a -> f a) -> Rec1 f a -> f b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Rec1 f a -> f a
forall k (f :: k -> *) (p :: k). Rec1 f p -> f p
unRec1
instance Extend Monoid.Sum where
extended :: (Sum a -> b) -> Sum a -> Sum b
extended Sum a -> b
f w :: Sum a
w@Monoid.Sum{} = b -> Sum b
forall a. a -> Sum a
Monoid.Sum (Sum a -> b
f Sum a
w)
instance Extend Monoid.Product where
extended :: (Product a -> b) -> Product a -> Product b
extended Product a -> b
f w :: Product a
w@Monoid.Product{} = b -> Product b
forall a. a -> Product a
Monoid.Product (Product a -> b
f Product a
w)
instance Extend Monoid.Dual where
extended :: (Dual a -> b) -> Dual a -> Dual b
extended Dual a -> b
f w :: Dual a
w@Monoid.Dual{} = b -> Dual b
forall a. a -> Dual a
Monoid.Dual (Dual a -> b
f Dual a
w)
#if MIN_VERSION_base(4,8,0)
instance Extend f => Extend (Monoid.Alt f) where
extended :: (Alt f a -> b) -> Alt f a -> Alt f b
extended Alt f a -> b
f = f b -> Alt f b
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Monoid.Alt (f b -> Alt f b) -> (Alt f a -> f b) -> Alt f a -> Alt f b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (f a -> b) -> f a -> f b
forall (w :: * -> *) a b. Extend w => (w a -> b) -> w a -> w b
extended (Alt f a -> b
f (Alt f a -> b) -> (f a -> Alt f a) -> f a -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f a -> Alt f a
forall k (f :: k -> *) (a :: k). f a -> Alt f a
Monoid.Alt) (f a -> f b) -> (Alt f a -> f a) -> Alt f a -> f b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Alt f a -> f a
forall k (f :: k -> *) (a :: k). Alt f a -> f a
Monoid.getAlt
#endif
instance Extend Semigroup.First where
extended :: (First a -> b) -> First a -> First b
extended First a -> b
f w :: First a
w@Semigroup.First{} = b -> First b
forall a. a -> First a
Semigroup.First (First a -> b
f First a
w)
instance Extend Semigroup.Last where
extended :: (Last a -> b) -> Last a -> Last b
extended Last a -> b
f w :: Last a
w@Semigroup.Last{} = b -> Last b
forall a. a -> Last a
Semigroup.Last (Last a -> b
f Last a
w)
instance Extend Semigroup.Min where
extended :: (Min a -> b) -> Min a -> Min b
extended Min a -> b
f w :: Min a
w@Semigroup.Min{} = b -> Min b
forall a. a -> Min a
Semigroup.Min (Min a -> b
f Min a
w)
instance Extend Semigroup.Max where
extended :: (Max a -> b) -> Max a -> Max b
extended Max a -> b
f w :: Max a
w@Semigroup.Max{} = b -> Max b
forall a. a -> Max a
Semigroup.Max (Max a -> b
f Max a
w)