{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Data.Vessel.Identity where

import Data.Aeson
import Data.Patch (Group(..), Additive)
import GHC.Generics
import Data.Functor.Compose
import Data.Functor.Const
import Data.Functor.Identity
import Data.These

import Data.Vessel.Class
import Data.Vessel.Selectable
import Data.Vessel.ViewMorphism

-- | A functor-indexed container corresponding to Identity. (i.e. a single non-deletable item)
newtype IdentityV (a :: *) (g :: * -> *) = IdentityV { IdentityV a g -> g a
unIdentityV :: g a }
  deriving (IdentityV a g -> IdentityV a g -> Bool
(IdentityV a g -> IdentityV a g -> Bool)
-> (IdentityV a g -> IdentityV a g -> Bool) -> Eq (IdentityV a g)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a (g :: * -> *).
Eq (g a) =>
IdentityV a g -> IdentityV a g -> Bool
/= :: IdentityV a g -> IdentityV a g -> Bool
$c/= :: forall a (g :: * -> *).
Eq (g a) =>
IdentityV a g -> IdentityV a g -> Bool
== :: IdentityV a g -> IdentityV a g -> Bool
$c== :: forall a (g :: * -> *).
Eq (g a) =>
IdentityV a g -> IdentityV a g -> Bool
Eq, Eq (IdentityV a g)
Eq (IdentityV a g)
-> (IdentityV a g -> IdentityV a g -> Ordering)
-> (IdentityV a g -> IdentityV a g -> Bool)
-> (IdentityV a g -> IdentityV a g -> Bool)
-> (IdentityV a g -> IdentityV a g -> Bool)
-> (IdentityV a g -> IdentityV a g -> Bool)
-> (IdentityV a g -> IdentityV a g -> IdentityV a g)
-> (IdentityV a g -> IdentityV a g -> IdentityV a g)
-> Ord (IdentityV a g)
IdentityV a g -> IdentityV a g -> Bool
IdentityV a g -> IdentityV a g -> Ordering
IdentityV a g -> IdentityV a g -> IdentityV a g
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a (g :: * -> *). Ord (g a) => Eq (IdentityV a g)
forall a (g :: * -> *).
Ord (g a) =>
IdentityV a g -> IdentityV a g -> Bool
forall a (g :: * -> *).
Ord (g a) =>
IdentityV a g -> IdentityV a g -> Ordering
forall a (g :: * -> *).
Ord (g a) =>
IdentityV a g -> IdentityV a g -> IdentityV a g
min :: IdentityV a g -> IdentityV a g -> IdentityV a g
$cmin :: forall a (g :: * -> *).
Ord (g a) =>
IdentityV a g -> IdentityV a g -> IdentityV a g
max :: IdentityV a g -> IdentityV a g -> IdentityV a g
$cmax :: forall a (g :: * -> *).
Ord (g a) =>
IdentityV a g -> IdentityV a g -> IdentityV a g
>= :: IdentityV a g -> IdentityV a g -> Bool
$c>= :: forall a (g :: * -> *).
Ord (g a) =>
IdentityV a g -> IdentityV a g -> Bool
> :: IdentityV a g -> IdentityV a g -> Bool
$c> :: forall a (g :: * -> *).
Ord (g a) =>
IdentityV a g -> IdentityV a g -> Bool
<= :: IdentityV a g -> IdentityV a g -> Bool
$c<= :: forall a (g :: * -> *).
Ord (g a) =>
IdentityV a g -> IdentityV a g -> Bool
< :: IdentityV a g -> IdentityV a g -> Bool
$c< :: forall a (g :: * -> *).
Ord (g a) =>
IdentityV a g -> IdentityV a g -> Bool
compare :: IdentityV a g -> IdentityV a g -> Ordering
$ccompare :: forall a (g :: * -> *).
Ord (g a) =>
IdentityV a g -> IdentityV a g -> Ordering
$cp1Ord :: forall a (g :: * -> *). Ord (g a) => Eq (IdentityV a g)
Ord, Int -> IdentityV a g -> ShowS
[IdentityV a g] -> ShowS
IdentityV a g -> String
(Int -> IdentityV a g -> ShowS)
-> (IdentityV a g -> String)
-> ([IdentityV a g] -> ShowS)
-> Show (IdentityV a g)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a (g :: * -> *). Show (g a) => Int -> IdentityV a g -> ShowS
forall a (g :: * -> *). Show (g a) => [IdentityV a g] -> ShowS
forall a (g :: * -> *). Show (g a) => IdentityV a g -> String
showList :: [IdentityV a g] -> ShowS
$cshowList :: forall a (g :: * -> *). Show (g a) => [IdentityV a g] -> ShowS
show :: IdentityV a g -> String
$cshow :: forall a (g :: * -> *). Show (g a) => IdentityV a g -> String
showsPrec :: Int -> IdentityV a g -> ShowS
$cshowsPrec :: forall a (g :: * -> *). Show (g a) => Int -> IdentityV a g -> ShowS
Show, ReadPrec [IdentityV a g]
ReadPrec (IdentityV a g)
Int -> ReadS (IdentityV a g)
ReadS [IdentityV a g]
(Int -> ReadS (IdentityV a g))
-> ReadS [IdentityV a g]
-> ReadPrec (IdentityV a g)
-> ReadPrec [IdentityV a g]
-> Read (IdentityV a g)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall a (g :: * -> *). Read (g a) => ReadPrec [IdentityV a g]
forall a (g :: * -> *). Read (g a) => ReadPrec (IdentityV a g)
forall a (g :: * -> *). Read (g a) => Int -> ReadS (IdentityV a g)
forall a (g :: * -> *). Read (g a) => ReadS [IdentityV a g]
readListPrec :: ReadPrec [IdentityV a g]
$creadListPrec :: forall a (g :: * -> *). Read (g a) => ReadPrec [IdentityV a g]
readPrec :: ReadPrec (IdentityV a g)
$creadPrec :: forall a (g :: * -> *). Read (g a) => ReadPrec (IdentityV a g)
readList :: ReadS [IdentityV a g]
$creadList :: forall a (g :: * -> *). Read (g a) => ReadS [IdentityV a g]
readsPrec :: Int -> ReadS (IdentityV a g)
$creadsPrec :: forall a (g :: * -> *). Read (g a) => Int -> ReadS (IdentityV a g)
Read, b -> IdentityV a g -> IdentityV a g
NonEmpty (IdentityV a g) -> IdentityV a g
IdentityV a g -> IdentityV a g -> IdentityV a g
(IdentityV a g -> IdentityV a g -> IdentityV a g)
-> (NonEmpty (IdentityV a g) -> IdentityV a g)
-> (forall b. Integral b => b -> IdentityV a g -> IdentityV a g)
-> Semigroup (IdentityV a g)
forall b. Integral b => b -> IdentityV a g -> IdentityV a g
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a (g :: * -> *).
Semigroup (g a) =>
NonEmpty (IdentityV a g) -> IdentityV a g
forall a (g :: * -> *).
Semigroup (g a) =>
IdentityV a g -> IdentityV a g -> IdentityV a g
forall a (g :: * -> *) b.
(Semigroup (g a), Integral b) =>
b -> IdentityV a g -> IdentityV a g
stimes :: b -> IdentityV a g -> IdentityV a g
$cstimes :: forall a (g :: * -> *) b.
(Semigroup (g a), Integral b) =>
b -> IdentityV a g -> IdentityV a g
sconcat :: NonEmpty (IdentityV a g) -> IdentityV a g
$csconcat :: forall a (g :: * -> *).
Semigroup (g a) =>
NonEmpty (IdentityV a g) -> IdentityV a g
<> :: IdentityV a g -> IdentityV a g -> IdentityV a g
$c<> :: forall a (g :: * -> *).
Semigroup (g a) =>
IdentityV a g -> IdentityV a g -> IdentityV a g
Semigroup, Semigroup (IdentityV a g)
IdentityV a g
Semigroup (IdentityV a g)
-> IdentityV a g
-> (IdentityV a g -> IdentityV a g -> IdentityV a g)
-> ([IdentityV a g] -> IdentityV a g)
-> Monoid (IdentityV a g)
[IdentityV a g] -> IdentityV a g
IdentityV a g -> IdentityV a g -> IdentityV a g
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a (g :: * -> *). Monoid (g a) => Semigroup (IdentityV a g)
forall a (g :: * -> *). Monoid (g a) => IdentityV a g
forall a (g :: * -> *).
Monoid (g a) =>
[IdentityV a g] -> IdentityV a g
forall a (g :: * -> *).
Monoid (g a) =>
IdentityV a g -> IdentityV a g -> IdentityV a g
mconcat :: [IdentityV a g] -> IdentityV a g
$cmconcat :: forall a (g :: * -> *).
Monoid (g a) =>
[IdentityV a g] -> IdentityV a g
mappend :: IdentityV a g -> IdentityV a g -> IdentityV a g
$cmappend :: forall a (g :: * -> *).
Monoid (g a) =>
IdentityV a g -> IdentityV a g -> IdentityV a g
mempty :: IdentityV a g
$cmempty :: forall a (g :: * -> *). Monoid (g a) => IdentityV a g
$cp1Monoid :: forall a (g :: * -> *). Monoid (g a) => Semigroup (IdentityV a g)
Monoid, Semigroup (IdentityV a g)
Monoid (IdentityV a g)
Semigroup (IdentityV a g)
-> Monoid (IdentityV a g)
-> (IdentityV a g -> IdentityV a g)
-> (IdentityV a g -> IdentityV a g -> IdentityV a g)
-> Group (IdentityV a g)
IdentityV a g -> IdentityV a g
IdentityV a g -> IdentityV a g -> IdentityV a g
forall q.
Semigroup q -> Monoid q -> (q -> q) -> (q -> q -> q) -> Group q
forall a (g :: * -> *). Group (g a) => Semigroup (IdentityV a g)
forall a (g :: * -> *). Group (g a) => Monoid (IdentityV a g)
forall a (g :: * -> *).
Group (g a) =>
IdentityV a g -> IdentityV a g
forall a (g :: * -> *).
Group (g a) =>
IdentityV a g -> IdentityV a g -> IdentityV a g
~~ :: IdentityV a g -> IdentityV a g -> IdentityV a g
$c~~ :: forall a (g :: * -> *).
Group (g a) =>
IdentityV a g -> IdentityV a g -> IdentityV a g
negateG :: IdentityV a g -> IdentityV a g
$cnegateG :: forall a (g :: * -> *).
Group (g a) =>
IdentityV a g -> IdentityV a g
$cp2Group :: forall a (g :: * -> *). Group (g a) => Monoid (IdentityV a g)
$cp1Group :: forall a (g :: * -> *). Group (g a) => Semigroup (IdentityV a g)
Group, Semigroup (IdentityV a g)
Semigroup (IdentityV a g) -> Additive (IdentityV a g)
forall q. Semigroup q -> Additive q
forall a (g :: * -> *).
Semigroup (g a) =>
Semigroup (IdentityV a g)
Additive, (forall x. IdentityV a g -> Rep (IdentityV a g) x)
-> (forall x. Rep (IdentityV a g) x -> IdentityV a g)
-> Generic (IdentityV a g)
forall x. Rep (IdentityV a g) x -> IdentityV a g
forall x. IdentityV a g -> Rep (IdentityV a g) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a (g :: * -> *) x. Rep (IdentityV a g) x -> IdentityV a g
forall a (g :: * -> *) x. IdentityV a g -> Rep (IdentityV a g) x
$cto :: forall a (g :: * -> *) x. Rep (IdentityV a g) x -> IdentityV a g
$cfrom :: forall a (g :: * -> *) x. IdentityV a g -> Rep (IdentityV a g) x
Generic, [IdentityV a g] -> Encoding
[IdentityV a g] -> Value
IdentityV a g -> Encoding
IdentityV a g -> Value
(IdentityV a g -> Value)
-> (IdentityV a g -> Encoding)
-> ([IdentityV a g] -> Value)
-> ([IdentityV a g] -> Encoding)
-> ToJSON (IdentityV a g)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
forall a (g :: * -> *). ToJSON (g a) => [IdentityV a g] -> Encoding
forall a (g :: * -> *). ToJSON (g a) => [IdentityV a g] -> Value
forall a (g :: * -> *). ToJSON (g a) => IdentityV a g -> Encoding
forall a (g :: * -> *). ToJSON (g a) => IdentityV a g -> Value
toEncodingList :: [IdentityV a g] -> Encoding
$ctoEncodingList :: forall a (g :: * -> *). ToJSON (g a) => [IdentityV a g] -> Encoding
toJSONList :: [IdentityV a g] -> Value
$ctoJSONList :: forall a (g :: * -> *). ToJSON (g a) => [IdentityV a g] -> Value
toEncoding :: IdentityV a g -> Encoding
$ctoEncoding :: forall a (g :: * -> *). ToJSON (g a) => IdentityV a g -> Encoding
toJSON :: IdentityV a g -> Value
$ctoJSON :: forall a (g :: * -> *). ToJSON (g a) => IdentityV a g -> Value
ToJSON, Value -> Parser [IdentityV a g]
Value -> Parser (IdentityV a g)
(Value -> Parser (IdentityV a g))
-> (Value -> Parser [IdentityV a g]) -> FromJSON (IdentityV a g)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
forall a (g :: * -> *).
FromJSON (g a) =>
Value -> Parser [IdentityV a g]
forall a (g :: * -> *).
FromJSON (g a) =>
Value -> Parser (IdentityV a g)
parseJSONList :: Value -> Parser [IdentityV a g]
$cparseJSONList :: forall a (g :: * -> *).
FromJSON (g a) =>
Value -> Parser [IdentityV a g]
parseJSON :: Value -> Parser (IdentityV a g)
$cparseJSON :: forall a (g :: * -> *).
FromJSON (g a) =>
Value -> Parser (IdentityV a g)
FromJSON)

instance View (IdentityV a) where
  cropV :: (forall a. s a -> i a -> r a)
-> IdentityV a s -> IdentityV a i -> Maybe (IdentityV a r)
cropV forall a. s a -> i a -> r a
f (IdentityV s a
s) (IdentityV i a
x) = IdentityV a r -> Maybe (IdentityV a r)
forall a. a -> Maybe a
Just (IdentityV a r -> Maybe (IdentityV a r))
-> IdentityV a r -> Maybe (IdentityV a r)
forall a b. (a -> b) -> a -> b
$ r a -> IdentityV a r
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV (r a -> IdentityV a r) -> r a -> IdentityV a r
forall a b. (a -> b) -> a -> b
$ s a -> i a -> r a
forall a. s a -> i a -> r a
f s a
s i a
x
  nullV :: IdentityV a i -> Bool
nullV IdentityV a i
_ = Bool
False
  condenseV :: t (IdentityV a g) -> IdentityV a (Compose t g)
condenseV t (IdentityV a g)
m = Compose t g a -> IdentityV a (Compose t g)
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV (t (g a) -> Compose t g a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((IdentityV a g -> g a) -> t (IdentityV a g) -> t (g a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IdentityV a g -> g a
forall a (g :: * -> *). IdentityV a g -> g a
unIdentityV t (IdentityV a g)
m))
  disperseV :: IdentityV a (Compose t g) -> t (IdentityV a g)
disperseV (IdentityV (Compose t (g a)
m)) = (g a -> IdentityV a g) -> t (g a) -> t (IdentityV a g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g a -> IdentityV a g
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV t (g a)
m
  mapV :: (forall a. f a -> g a) -> IdentityV a f -> IdentityV a g
mapV forall a. f a -> g a
f (IdentityV f a
x) = g a -> IdentityV a g
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV (f a -> g a
forall a. f a -> g a
f f a
x)
  traverseV :: (forall a. f a -> m (g a)) -> IdentityV a f -> m (IdentityV a g)
traverseV forall a. f a -> m (g a)
f (IdentityV f a
x) = g a -> IdentityV a g
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV (g a -> IdentityV a g) -> m (g a) -> m (IdentityV a g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (g a)
forall a. f a -> m (g a)
f f a
x
  mapMaybeV :: (forall a. f a -> Maybe (g a))
-> IdentityV a f -> Maybe (IdentityV a g)
mapMaybeV forall a. f a -> Maybe (g a)
f (IdentityV f a
x) = g a -> IdentityV a g
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV (g a -> IdentityV a g) -> Maybe (g a) -> Maybe (IdentityV a g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> Maybe (g a)
forall a. f a -> Maybe (g a)
f f a
x
  alignWithMaybeV :: (forall a. These (f a) (g a) -> Maybe (h a))
-> IdentityV a f -> IdentityV a g -> Maybe (IdentityV a h)
alignWithMaybeV forall a. These (f a) (g a) -> Maybe (h a)
f (IdentityV f a
x) (IdentityV g a
y) = h a -> IdentityV a h
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV (h a -> IdentityV a h) -> Maybe (h a) -> Maybe (IdentityV a h)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> These (f a) (g a) -> Maybe (h a)
forall a. These (f a) (g a) -> Maybe (h a)
f (f a -> g a -> These (f a) (g a)
forall a b. a -> b -> These a b
These f a
x g a
y)
  alignWithV :: (forall a. These (f a) (g a) -> h a)
-> IdentityV a f -> IdentityV a g -> IdentityV a h
alignWithV forall a. These (f a) (g a) -> h a
f (IdentityV f a
x) (IdentityV g a
y) = h a -> IdentityV a h
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV (h a -> IdentityV a h) -> h a -> IdentityV a h
forall a b. (a -> b) -> a -> b
$ These (f a) (g a) -> h a
forall a. These (f a) (g a) -> h a
f (These (f a) (g a) -> h a) -> These (f a) (g a) -> h a
forall a b. (a -> b) -> a -> b
$ f a -> g a -> These (f a) (g a)
forall a b. a -> b -> These a b
These f a
x g a
y

instance Selectable (IdentityV a) () where
  type Selection (IdentityV a) () = a
  selector :: (forall a. p a) -> () -> IdentityV a p
selector forall a. p a
p () = p a -> IdentityV a p
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV p a
forall a. p a
p
  selection :: () -> IdentityV a Identity -> Selection (IdentityV a) ()
selection () (IdentityV (Identity a
a)) = a
Selection (IdentityV a) ()
a

lookupIdentityV :: IdentityV a Identity -> a
lookupIdentityV :: IdentityV a Identity -> a
lookupIdentityV = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a)
-> (IdentityV a Identity -> Identity a)
-> IdentityV a Identity
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentityV a Identity -> Identity a
forall a (g :: * -> *). IdentityV a g -> g a
unIdentityV

type instance ViewQueryResult (IdentityV a (Const g)) = IdentityV a Identity

identityV :: (Applicative m, Applicative n) => ViewMorphism m n (Const g a) (IdentityV a (Const g))
identityV :: ViewMorphism m n (Const g a) (IdentityV a (Const g))
identityV = ViewHalfMorphism m n (Const g a) (IdentityV a (Const g))
-> ViewHalfMorphism n m (IdentityV a (Const g)) (Const g a)
-> ViewMorphism m n (Const g a) (IdentityV a (Const g))
forall (m :: * -> *) (n :: * -> *) p q.
ViewHalfMorphism m n p q
-> ViewHalfMorphism n m q p -> ViewMorphism m n p q
ViewMorphism ViewHalfMorphism m n (Const g a) (IdentityV a (Const g))
forall (m :: * -> *) (n :: * -> *) g a.
(Applicative m, Applicative n) =>
ViewHalfMorphism m n (Const g a) (IdentityV a (Const g))
toIdentityV ViewHalfMorphism n m (IdentityV a (Const g)) (Const g a)
forall (m :: * -> *) (n :: * -> *) a g.
(Applicative m, Applicative n) =>
ViewHalfMorphism m n (IdentityV a (Const g)) (Const g a)
fromIdentityV

toIdentityV :: (Applicative m, Applicative n) => ViewHalfMorphism m n (Const g a) (IdentityV a (Const g))
toIdentityV :: ViewHalfMorphism m n (Const g a) (IdentityV a (Const g))
toIdentityV = ViewHalfMorphism :: forall (m :: * -> *) (n :: * -> *) p q.
(p -> m q)
-> (ViewQueryResult q -> n (ViewQueryResult p))
-> ViewHalfMorphism m n p q
ViewHalfMorphism
  { _viewMorphism_mapQuery :: Const g a -> m (IdentityV a (Const g))
_viewMorphism_mapQuery = IdentityV a (Const g) -> m (IdentityV a (Const g))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdentityV a (Const g) -> m (IdentityV a (Const g)))
-> (Const g a -> IdentityV a (Const g))
-> Const g a
-> m (IdentityV a (Const g))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const g a -> IdentityV a (Const g)
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV
  , _viewMorphism_mapQueryResult :: ViewQueryResult (IdentityV a (Const g))
-> n (ViewQueryResult (Const g a))
_viewMorphism_mapQueryResult = Identity a -> n (Identity a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identity a -> n (Identity a))
-> (IdentityV a Identity -> Identity a)
-> IdentityV a Identity
-> n (Identity a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentityV a Identity -> Identity a
forall a (g :: * -> *). IdentityV a g -> g a
unIdentityV
  }
fromIdentityV :: (Applicative m, Applicative n) => ViewHalfMorphism m n (IdentityV a (Const g)) (Const g a)
fromIdentityV :: ViewHalfMorphism m n (IdentityV a (Const g)) (Const g a)
fromIdentityV = ViewHalfMorphism :: forall (m :: * -> *) (n :: * -> *) p q.
(p -> m q)
-> (ViewQueryResult q -> n (ViewQueryResult p))
-> ViewHalfMorphism m n p q
ViewHalfMorphism
  { _viewMorphism_mapQuery :: IdentityV a (Const g) -> m (Const g a)
_viewMorphism_mapQuery = Const g a -> m (Const g a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Const g a -> m (Const g a))
-> (IdentityV a (Const g) -> Const g a)
-> IdentityV a (Const g)
-> m (Const g a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentityV a (Const g) -> Const g a
forall a (g :: * -> *). IdentityV a g -> g a
unIdentityV
  , _viewMorphism_mapQueryResult :: ViewQueryResult (Const g a)
-> n (ViewQueryResult (IdentityV a (Const g)))
_viewMorphism_mapQueryResult = IdentityV a Identity -> n (IdentityV a Identity)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IdentityV a Identity -> n (IdentityV a Identity))
-> (Identity a -> IdentityV a Identity)
-> Identity a
-> n (IdentityV a Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> IdentityV a Identity
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV
  }

-- | A gadget to "traverse" over an IdentityV
handleIdentityVSelector
  :: forall a f g m. Functor m
  => (forall x. x -> f x -> g x)
  -> m a
  ->    IdentityV a f
  -> m (IdentityV a g)
handleIdentityVSelector :: (forall x. x -> f x -> g x)
-> m a -> IdentityV a f -> m (IdentityV a g)
handleIdentityVSelector forall x. x -> f x -> g x
k m a
f (IdentityV f a
xs) = (\a
y -> g a -> IdentityV a g
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV (g a -> IdentityV a g) -> g a -> IdentityV a g
forall a b. (a -> b) -> a -> b
$ a -> f a -> g a
forall x. x -> f x -> g x
k a
y f a
xs) (a -> IdentityV a g) -> m a -> m (IdentityV a g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
f

-- | Non-existentialized map; since the contained value is known
mapIdentityV :: (f a -> g a) -> IdentityV a f -> IdentityV a g
mapIdentityV :: (f a -> g a) -> IdentityV a f -> IdentityV a g
mapIdentityV f a -> g a
f (IdentityV f a
xs) = g a -> IdentityV a g
forall a (g :: * -> *). g a -> IdentityV a g
IdentityV (f a -> g a
f f a
xs)