{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
-- | lifted promoted functions

module Predicate.Data.Lifted (
 -- ** functor

    FMap
  , type (<$>)
  , type (<&>)

 -- ** applicative

  , Pure
  , type (<*>)
  , LiftA2
  , FPair
  , type (<:>)
  , type (<$)
  , type (<*)
  , type (*>)

 -- ** monad

  , FFish
  , type (>>=)
  , Sequence
  , Traverse
  , Join

 -- ** alternative

  , type (<|>)
  , EmptyT
  , EmptyT'
  , EmptyList
  , EmptyList'
  , EmptyBool
  , EmptyBool'

 -- ** bifunctor

  , BiMap
  , BiFoldMap

 -- ** comonad

  , Extract
  , Duplicate

 -- ** function application

  , type ($$)
  , type ($&)
  , Skip
  , type (|>)
  , type (>|)
  , type (>|>)
  , Flip
  , Dot
  , RDot
  , K
  , Lift

 -- ** coerce

  , Coerce

 -- ** error handling

  , Catch
  , Catch'

 -- ** type families

  , DotExpandT
  , RDotExpandT
 ) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Predicate.Elr (getBifoldInfo)
import qualified GHC.TypeLits as GL
import Control.Applicative
import Control.Monad (join)
import Data.Kind (Type)
import Control.Comonad (Comonad(duplicate, extract))
import Control.Lens
import Data.Tree (Tree)
import Data.Proxy (Proxy(..))
import Data.Bitraversable
import Data.Bifoldable
import Data.Coerce (Coercible)
-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> import qualified Data.Text as T

-- >>> import Predicate

-- >>> import qualified Data.Semigroup as SG

-- >>> import Data.Functor.Identity

-- >>> import Data.These

-- >>> :m + Data.Typeable

-- >>> :m + Data.Ratio

-- >>> :m + Control.Lens

-- >>> :m + Control.Lens.Action


-- | similar to 'Control.Applicative.<$'

--

-- >>> pz @(Fst <$ Snd) ("abc",Just 20)

-- Val (Just "abc")

--

-- >>> pl @(Fst <$ Snd) (4,These "xxx" 'a')

-- Present These "xxx" 4 ((<$) 4)

-- Val (These "xxx" 4)

--

-- >>> pl @(Fst <$ Snd) (4,This 'a')

-- Present This 'a' ((<$) 4)

-- Val (This 'a')

--

-- >>> pl @(Fst <$ Snd) (4,Just 'a')

-- Present Just 4 ((<$) 4)

-- Val (Just 4)

--

-- >>> pl @(Fst <$ Snd) (4,Nothing @Int)

-- Present Nothing ((<$) 4)

-- Val Nothing

--

-- >>> pl @('True <$ Id) [1..4]

-- Present [True,True,True,True] ((<$) True)

-- Val [True,True,True,True]

--

-- >>> import Data.Functor.Compose

-- >>> pl @(C "ab" <$ Id) (Compose $ Just [1..4])

-- Present Compose (Just "aaaa") ((<$) 'a')

-- Val (Compose (Just "aaaa"))

--

-- >>> pl @(Snd <$ Fst) (Just 10,'x')

-- Present Just 'x' ((<$) 'x')

-- Val (Just 'x')

--

data p <$ q deriving Int -> (p <$ q) -> ShowS
[p <$ q] -> ShowS
(p <$ q) -> String
(Int -> (p <$ q) -> ShowS)
-> ((p <$ q) -> String) -> ([p <$ q] -> ShowS) -> Show (p <$ q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <$ q) -> ShowS
forall k (p :: k) k (q :: k). [p <$ q] -> ShowS
forall k (p :: k) k (q :: k). (p <$ q) -> String
showList :: [p <$ q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <$ q] -> ShowS
show :: (p <$ q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <$ q) -> String
showsPrec :: Int -> (p <$ q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <$ q) -> ShowS
Show
infixl 4 <$

instance ( P p x
         , P q x
         , Show (PP p x)
         , Functor t
         , PP q x ~ t c
         , ApplyConstT (PP q x) (PP p x) ~ t (PP p x)
         ) => P (p <$ q) x where
  type PP (p <$ q) x = ApplyConstT (PP q x) (PP p x)
  eval :: proxy (p <$ q) -> POpts -> x -> m (TT (PP (p <$ q) x))
eval proxy (p <$ q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"(<$)"
    Either (TT (t (PP p x))) (PP p x, t c, TT (PP p x), TT (t c))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT (t (PP p x))) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    TT (t (PP p x)) -> m (TT (t (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t (PP p x)) -> m (TT (t (PP p x))))
-> TT (t (PP p x)) -> m (TT (t (PP p x)))
forall a b. (a -> b) -> a -> b
$ case Either (TT (t (PP p x))) (PP p x, t c, TT (PP p x), TT (t c))
lr of
      Left TT (t (PP p x))
e -> TT (t (PP p x))
e
      Right (PP p x
p,t c
q,TT (PP p x)
pp,TT (t c)
qq) ->
        let d :: t (PP p x)
d = PP p x
p PP p x -> t c -> t (PP p x)
forall (f :: Type -> Type) a b. Functor f => a -> f b -> f a
<$ t c
q
        in POpts -> Val (t (PP p x)) -> String -> [Tree PE] -> TT (t (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t (PP p x) -> Val (t (PP p x))
forall a. a -> Val a
Val t (PP p x)
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP p x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp, TT (t c) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t c)
qq]

-- | similar to Applicative 'Control.Applicative.<*'

--

-- >>> pl @(Fst <* Snd) (Just 4,Just 'a')

-- Present Just 4 ((<*) Just 4 | p=Just 4 | q=Just 'a')

-- Val (Just 4)

--

-- >>> pz @(Fst <* Snd) (Just "abc",Just 20)

-- Val (Just "abc")

--

-- >>> pz @('["x","y"] <* '[1,2,3]) ()

-- Val ["x","x","x","y","y","y"]

--

data p <* q deriving Int -> (p <* q) -> ShowS
[p <* q] -> ShowS
(p <* q) -> String
(Int -> (p <* q) -> ShowS)
-> ((p <* q) -> String) -> ([p <* q] -> ShowS) -> Show (p <* q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <* q) -> ShowS
forall k (p :: k) k (q :: k). [p <* q] -> ShowS
forall k (p :: k) k (q :: k). (p <* q) -> String
showList :: [p <* q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <* q] -> ShowS
show :: (p <* q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <* q) -> String
showsPrec :: Int -> (p <* q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <* q) -> ShowS
Show
infixl 4 <*

instance ( P p x
         , P q x
         , Show (t b)
         , Show (t c)
         , Applicative t
         , PP p x ~ t b
         , PP q x ~ t c
         ) => P (p <* q) x where
  type PP (p <* q) x = PP p x
  eval :: proxy (p <* q) -> POpts -> x -> m (TT (PP (p <* q) x))
eval proxy (p <* q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"(<*)"
    Either (TT (t b)) (t b, t c, TT (t b), TT (t c))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT (t b)) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    TT (t b) -> m (TT (t b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t b) -> m (TT (t b))) -> TT (t b) -> m (TT (t b))
forall a b. (a -> b) -> a -> b
$ case Either (TT (t b)) (t b, t c, TT (t b), TT (t c))
lr of
      Left TT (t b)
e -> TT (t b)
e
      Right (t b
p,t c
q,TT (t b)
pp,TT (t c)
qq) ->
        let d :: t b
d = t b
p t b -> t c -> t b
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f a
<* t c
q
        in POpts -> Val (t b) -> String -> [Tree PE] -> TT (t b)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t b -> Val (t b)
forall a. a -> Val a
Val t b
d) (POpts -> String -> t b -> String -> t b -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 t b
p String
"p=" t b
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> t c -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" t c
q) [TT (t b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t b)
pp, TT (t c) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t c)
qq]

-- | similar to Applicative 'Control.Applicative.*>'

--

-- >>> pl @(Fst *> Snd) (Just 4,Just 'a')

-- Present Just 'a' ((*>) Just 4 | p=Just 4 | q=Just 'a')

-- Val (Just 'a')

--

-- >>> pz @('["x","y"] *> '[1,2,3]) ()

-- Val [1,2,3,1,2,3]

--

data p *> q deriving Int -> (p *> q) -> ShowS
[p *> q] -> ShowS
(p *> q) -> String
(Int -> (p *> q) -> ShowS)
-> ((p *> q) -> String) -> ([p *> q] -> ShowS) -> Show (p *> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p *> q) -> ShowS
forall k (p :: k) k (q :: k). [p *> q] -> ShowS
forall k (p :: k) k (q :: k). (p *> q) -> String
showList :: [p *> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p *> q] -> ShowS
show :: (p *> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p *> q) -> String
showsPrec :: Int -> (p *> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p *> q) -> ShowS
Show
infixl 4 *>

instance ( P p x
         , P q x
         , Show (t b)
         , Show (t c)
         , Applicative t
         , PP p x ~ t b
         , PP q x ~ t c
         ) => P (p *> q) x where
  type PP (p *> q) x = PP q x
  eval :: proxy (p *> q) -> POpts -> x -> m (TT (PP (p *> q) x))
eval proxy (p *> q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"(*>)"
    Either (TT (t c)) (t b, t c, TT (t b), TT (t c))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT (t c)) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    TT (t c) -> m (TT (t c))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t c) -> m (TT (t c))) -> TT (t c) -> m (TT (t c))
forall a b. (a -> b) -> a -> b
$ case Either (TT (t c)) (t b, t c, TT (t b), TT (t c))
lr of
      Left TT (t c)
e -> TT (t c)
e
      Right (t b
p,t c
q,TT (t b)
pp,TT (t c)
qq) ->
        let d :: t c
d = t b
p t b -> t c -> t c
forall (f :: Type -> Type) a b. Applicative f => f a -> f b -> f b
*> t c
q
        in POpts -> Val (t c) -> String -> [Tree PE] -> TT (t c)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t c -> Val (t c)
forall a. a -> Val a
Val t c
d) (POpts -> String -> t b -> String -> t b -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 t b
p String
"p=" t b
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> t c -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" t c
q) [TT (t b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t b)
pp, TT (t c) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t c)
qq]

-- | similar to 'Control.Applicative.<|>'

--

-- >>> pz @(Fst <|> Snd) (Nothing,Just 20)

-- Val (Just 20)

--

-- >>> pz @(Fst <|> Snd) (Just 10,Just 20)

-- Val (Just 10)

--

-- >>> pz @(Fst <|> Snd) (Nothing,Nothing)

-- Val Nothing

--

-- >>> pl @(Fst <|> Snd) (Just "cdef",Just "ab")

-- Present Just "cdef" ((<|>) Just "cdef" | p=Just "cdef" | q=Just "ab")

-- Val (Just "cdef")

--

-- >>> pl @(Fst <|> Snd) ("cdef","ab"::String)

-- Present "cdefab" ((<|>) "cdefab" | p="cdef" | q="ab")

-- Val "cdefab"

--

data p <|> q deriving Int -> (p <|> q) -> ShowS
[p <|> q] -> ShowS
(p <|> q) -> String
(Int -> (p <|> q) -> ShowS)
-> ((p <|> q) -> String) -> ([p <|> q] -> ShowS) -> Show (p <|> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <|> q) -> ShowS
forall k (p :: k) k (q :: k). [p <|> q] -> ShowS
forall k (p :: k) k (q :: k). (p <|> q) -> String
showList :: [p <|> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <|> q] -> ShowS
show :: (p <|> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <|> q) -> String
showsPrec :: Int -> (p <|> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <|> q) -> ShowS
Show
infixl 3 <|>

instance ( P p x
         , P q x
         , Show (t b)
         , Alternative t
         , t b ~ PP p x
         , PP q x ~ t b
         ) => P (p <|> q) x where
  type PP (p <|> q) x = PP p x
  eval :: proxy (p <|> q) -> POpts -> x -> m (TT (PP (p <|> q) x))
eval proxy (p <|> q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"(<|>)"
    Either (TT (t b)) (t b, t b, TT (t b), TT (t b))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT (t b)) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    TT (t b) -> m (TT (t b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t b) -> m (TT (t b))) -> TT (t b) -> m (TT (t b))
forall a b. (a -> b) -> a -> b
$ case Either (TT (t b)) (t b, t b, TT (t b), TT (t b))
lr of
      Left TT (t b)
e -> TT (t b)
e
      Right (t b
p,t b
q,TT (t b)
pp,TT (t b)
qq) ->
        let d :: t b
d = t b
p t b -> t b -> t b
forall (f :: Type -> Type) a. Alternative f => f a -> f a -> f a
<|> t b
q
        in POpts -> Val (t b) -> String -> [Tree PE] -> TT (t b)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t b -> Val (t b)
forall a. a -> Val a
Val t b
d) (POpts -> String -> t b -> String -> t b -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 t b
d String
"p=" t b
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> t b -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" t b
q) [TT (t b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t b)
pp, TT (t b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t b)
qq]

-- | similar to 'Data.List.empty'

--

-- >>> pz @(EmptyT Maybe _) ()

-- Val Nothing

--

-- >>> pz @(EmptyT [] _) ()

-- Val []

--

-- >>> pz @(C "x" >> EmptyT [] String) (13,True)

-- Val []

--

-- >>> pz @(Fst >> EmptyT (Either String) _) (13,True)

-- Val (Left "")

--

-- >>> pz @(If 'True (MkJust 11) (EmptyT _ _)) ()

-- Val (Just 11)

--

-- >>> pz @(EmptyT [] _ <> "123") ()

-- Val "123"

--

data EmptyT (t :: Type -> Type) (t1 :: Type) deriving Int -> EmptyT t t1 -> ShowS
[EmptyT t t1] -> ShowS
EmptyT t t1 -> String
(Int -> EmptyT t t1 -> ShowS)
-> (EmptyT t t1 -> String)
-> ([EmptyT t t1] -> ShowS)
-> Show (EmptyT t t1)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: Type -> Type) t1. Int -> EmptyT t t1 -> ShowS
forall (t :: Type -> Type) t1. [EmptyT t t1] -> ShowS
forall (t :: Type -> Type) t1. EmptyT t t1 -> String
showList :: [EmptyT t t1] -> ShowS
$cshowList :: forall (t :: Type -> Type) t1. [EmptyT t t1] -> ShowS
show :: EmptyT t t1 -> String
$cshow :: forall (t :: Type -> Type) t1. EmptyT t t1 -> String
showsPrec :: Int -> EmptyT t t1 -> ShowS
$cshowsPrec :: forall (t :: Type -> Type) t1. Int -> EmptyT t t1 -> ShowS
Show
type EmptyTT (t :: Type -> Type) (t1 :: Type) = EmptyT' t (Hole t1)

instance Alternative t => P (EmptyT t t1) x where
  type PP (EmptyT t t1) x = PP (EmptyTT t t1) x
  eval :: proxy (EmptyT t t1) -> POpts -> x -> m (TT (PP (EmptyT t t1) x))
eval proxy (EmptyT t t1)
_ = Proxy (EmptyTT t t1) -> POpts -> x -> m (TT (PP (EmptyTT t t1) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (EmptyTT t t1)
forall k (t :: k). Proxy t
Proxy @(EmptyTT t t1))

-- | similar to 'Data.List.empty' where @t@ is the type of the container and @t1@ is a reference to the type of the items in the container

--

-- >>> pz @(EmptyT' [] "x") ()

-- Val []

--

-- >>> pz @(EmptyT' (Either String) (1 % 1)) ()

-- Val (Left "")

--

-- >>> pl @(If 'True (MkJust 11) (EmptyT' _ 0)) ()

-- Present Just 11 (If 'True Just 11)

-- Val (Just 11)

--

-- >>> pz @(If 'True (MkJust 11) (EmptyT' _ (Hole Int))) ()

-- Val (Just 11)

--

-- >>> pz @(If 'False (MkJust 11) (EmptyT' _ (Hole Int))) ()

-- Val Nothing


data EmptyT' (t :: Type -> Type) p deriving Int -> EmptyT' t p -> ShowS
[EmptyT' t p] -> ShowS
EmptyT' t p -> String
(Int -> EmptyT' t p -> ShowS)
-> (EmptyT' t p -> String)
-> ([EmptyT' t p] -> ShowS)
-> Show (EmptyT' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: Type -> Type) k (p :: k). Int -> EmptyT' t p -> ShowS
forall (t :: Type -> Type) k (p :: k). [EmptyT' t p] -> ShowS
forall (t :: Type -> Type) k (p :: k). EmptyT' t p -> String
showList :: [EmptyT' t p] -> ShowS
$cshowList :: forall (t :: Type -> Type) k (p :: k). [EmptyT' t p] -> ShowS
show :: EmptyT' t p -> String
$cshow :: forall (t :: Type -> Type) k (p :: k). EmptyT' t p -> String
showsPrec :: Int -> EmptyT' t p -> ShowS
$cshowsPrec :: forall (t :: Type -> Type) k (p :: k). Int -> EmptyT' t p -> ShowS
Show

instance Alternative t => P (EmptyT' t p) x where
  type PP (EmptyT' t p) x = t (PP p x)
  eval :: proxy (EmptyT' t p) -> POpts -> x -> m (TT (PP (EmptyT' t p) x))
eval proxy (EmptyT' t p)
_ POpts
opts x
_ =
    let msg0 :: String
msg0 = String
"EmptyT'"
        b :: t (PP p x)
b = forall a. Alternative t => t a
forall (f :: Type -> Type) a. Alternative f => f a
empty @t
    in TT (t (PP p x)) -> m (TT (t (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t (PP p x)) -> m (TT (t (PP p x))))
-> TT (t (PP p x)) -> m (TT (t (PP p x)))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (t (PP p x)) -> String -> [Tree PE] -> TT (t (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t (PP p x) -> Val (t (PP p x))
forall a. a -> Val a
Val t (PP p x)
b) String
msg0 []

-- | creates an empty list for the given pointer to a type @t@

--

-- >>> pz @(EmptyList' 123 +: Id) 99

-- Val [99]

--

data EmptyList' (t :: k) deriving Int -> EmptyList' t -> ShowS
[EmptyList' t] -> ShowS
EmptyList' t -> String
(Int -> EmptyList' t -> ShowS)
-> (EmptyList' t -> String)
-> ([EmptyList' t] -> ShowS)
-> Show (EmptyList' t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k). Int -> EmptyList' t -> ShowS
forall k (t :: k). [EmptyList' t] -> ShowS
forall k (t :: k). EmptyList' t -> String
showList :: [EmptyList' t] -> ShowS
$cshowList :: forall k (t :: k). [EmptyList' t] -> ShowS
show :: EmptyList' t -> String
$cshow :: forall k (t :: k). EmptyList' t -> String
showsPrec :: Int -> EmptyList' t -> ShowS
$cshowsPrec :: forall k (t :: k). Int -> EmptyList' t -> ShowS
Show
type EmptyListT' (t :: k) = EmptyT' [] t

instance P (EmptyList' t) x where
  type PP (EmptyList' t) x = PP (EmptyListT' t) x
  eval :: proxy (EmptyList' t) -> POpts -> x -> m (TT (PP (EmptyList' t) x))
eval proxy (EmptyList' t)
_ = Proxy (EmptyListT' t)
-> POpts -> x -> m (TT (PP (EmptyListT' t) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (EmptyListT' t)
forall k (t :: k). Proxy t
Proxy @(EmptyListT' t))

-- | creates an empty list for the given type

--

-- >>> pz @(Id :+ EmptyList _) 99

-- Val [99]

--

data EmptyList (t :: Type) deriving Int -> EmptyList t -> ShowS
[EmptyList t] -> ShowS
EmptyList t -> String
(Int -> EmptyList t -> ShowS)
-> (EmptyList t -> String)
-> ([EmptyList t] -> ShowS)
-> Show (EmptyList t)
forall t. Int -> EmptyList t -> ShowS
forall t. [EmptyList t] -> ShowS
forall t. EmptyList t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmptyList t] -> ShowS
$cshowList :: forall t. [EmptyList t] -> ShowS
show :: EmptyList t -> String
$cshow :: forall t. EmptyList t -> String
showsPrec :: Int -> EmptyList t -> ShowS
$cshowsPrec :: forall t. Int -> EmptyList t -> ShowS
Show
type EmptyListT (t :: Type) = EmptyT [] t

instance P (EmptyList t) x where
  type PP (EmptyList t) x = PP (EmptyListT t) x
  eval :: proxy (EmptyList t) -> POpts -> x -> m (TT (PP (EmptyList t) x))
eval proxy (EmptyList t)
_ = Proxy (EmptyListT t) -> POpts -> x -> m (TT (PP (EmptyListT t) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (EmptyListT t)
forall k (t :: k). Proxy t
Proxy @(EmptyListT t))

-- | Convenient method to convert a value @p@ to an Alternative based on a predicate @b@

--

--   if @b@ is True then pure @p@ else empty

--

-- >>> pz @(EmptyBool [] (Id > 4) 'True) 24

-- Val [True]

--

-- >>> pz @(EmptyBool [] (Id > 4) 'True) 1

-- Val []

--

data EmptyBool t b p deriving Int -> EmptyBool t b p -> ShowS
[EmptyBool t b p] -> ShowS
EmptyBool t b p -> String
(Int -> EmptyBool t b p -> ShowS)
-> (EmptyBool t b p -> String)
-> ([EmptyBool t b p] -> ShowS)
-> Show (EmptyBool t b p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (b :: k) k (p :: k).
Int -> EmptyBool t b p -> ShowS
forall k (t :: k) k (b :: k) k (p :: k). [EmptyBool t b p] -> ShowS
forall k (t :: k) k (b :: k) k (p :: k). EmptyBool t b p -> String
showList :: [EmptyBool t b p] -> ShowS
$cshowList :: forall k (t :: k) k (b :: k) k (p :: k). [EmptyBool t b p] -> ShowS
show :: EmptyBool t b p -> String
$cshow :: forall k (t :: k) k (b :: k) k (p :: k). EmptyBool t b p -> String
showsPrec :: Int -> EmptyBool t b p -> ShowS
$cshowsPrec :: forall k (t :: k) k (b :: k) k (p :: k).
Int -> EmptyBool t b p -> ShowS
Show

instance ( Show (PP p a)
         , P b a
         , P p a
         , PP b a ~ Bool
         , Alternative t
         ) => P (EmptyBool t b p) a where
  type PP (EmptyBool t b p) a = t (PP p a)
  eval :: proxy (EmptyBool t b p)
-> POpts -> a -> m (TT (PP (EmptyBool t b p) a))
eval proxy (EmptyBool t b p)
_ POpts
opts a
z = do
    let msg0 :: String
msg0 = String
"EmptyBool"
    TT Bool
bb <- Proxy b -> POpts -> a -> m (TT (PP b a))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy b
forall k (t :: k). Proxy t
Proxy @b) POpts
opts a
z
    case Inline
-> POpts
-> String
-> TT Bool
-> [Tree PE]
-> Either (TT (t (PP p a))) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" b failed") TT Bool
bb [] of
      Left TT (t (PP p a))
e -> TT (t (PP p a)) -> m (TT (t (PP p a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (t (PP p a))
e
      Right Bool
True -> do
        TT (PP p a)
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
z
        TT (t (PP p a)) -> m (TT (t (PP p a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t (PP p a)) -> m (TT (t (PP p a))))
-> TT (t (PP p a)) -> m (TT (t (PP p a)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT (t (PP p a))) (PP p a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" p failed") TT (PP p a)
pp [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
bb] of
          Left TT (t (PP p a))
e -> TT (t (PP p a))
e
          Right PP p a
p -> POpts -> Val (t (PP p a)) -> String -> [Tree PE] -> TT (t (PP p a))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t (PP p a) -> Val (t (PP p a))
forall a. a -> Val a
Val (PP p a -> t (PP p a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure PP p a
p)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(False) Just " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP p a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p a
p) [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
bb, TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]
      Right Bool
False -> TT (t (PP p a)) -> m (TT (t (PP p a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t (PP p a)) -> m (TT (t (PP p a))))
-> TT (t (PP p a)) -> m (TT (t (PP p a)))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (t (PP p a)) -> String -> [Tree PE] -> TT (t (PP p a))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t (PP p a) -> Val (t (PP p a))
forall a. a -> Val a
Val t (PP p a)
forall (f :: Type -> Type) a. Alternative f => f a
empty) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(True)") [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
bb]


-- | Convenient method to convert a value @p@ to an Alternative based on a predicate @b@

--   the value of p drives the choice of Alternative to use for the empty

--   similar to 'EmptyBool' but no need to provide @t@ as it is inferred from the resulting type of @p@

--

--   if @b@ is True then run @p@ else empty

--

-- >>> pz @(EmptyBool' (Id > 4) (MkJust (Id * 3))) 24

-- Val (Just 72)

--

-- >>> pz @(EmptyBool' (Id > 4) (MkJust (Id * 3))) 2

-- Val Nothing

--

-- >>> pz @(EmptyBool' (Len > 0) Head) ["Abcd","def","g"::String]

-- Val "Abcd"

--

-- >>> pz @(EmptyBool' (Len > 0) Head) ([] :: [String])

-- Val ""

--

data EmptyBool' b p deriving Int -> EmptyBool' b p -> ShowS
[EmptyBool' b p] -> ShowS
EmptyBool' b p -> String
(Int -> EmptyBool' b p -> ShowS)
-> (EmptyBool' b p -> String)
-> ([EmptyBool' b p] -> ShowS)
-> Show (EmptyBool' b p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (b :: k) k (p :: k). Int -> EmptyBool' b p -> ShowS
forall k (b :: k) k (p :: k). [EmptyBool' b p] -> ShowS
forall k (b :: k) k (p :: k). EmptyBool' b p -> String
showList :: [EmptyBool' b p] -> ShowS
$cshowList :: forall k (b :: k) k (p :: k). [EmptyBool' b p] -> ShowS
show :: EmptyBool' b p -> String
$cshow :: forall k (b :: k) k (p :: k). EmptyBool' b p -> String
showsPrec :: Int -> EmptyBool' b p -> ShowS
$cshowsPrec :: forall k (b :: k) k (p :: k). Int -> EmptyBool' b p -> ShowS
Show

instance ( Show (PP p a)
         , P b a
         , P p a
         , PP p a ~ t x
         , PP b a ~ Bool
         , Alternative t
         ) => P (EmptyBool' b p) a where
  type PP (EmptyBool' b p) a = PP p a
  eval :: proxy (EmptyBool' b p)
-> POpts -> a -> m (TT (PP (EmptyBool' b p) a))
eval proxy (EmptyBool' b p)
_ POpts
opts a
z = do
    let msg0 :: String
msg0 = String
"EmptyBool'"
    TT Bool
bb <- Proxy b -> POpts -> a -> m (TT (PP b a))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy b
forall k (t :: k). Proxy t
Proxy @b) POpts
opts a
z
    case Inline
-> POpts
-> String
-> TT Bool
-> [Tree PE]
-> Either (TT (t x)) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" b failed") TT Bool
bb [] of
      Left TT (t x)
e -> TT (t x) -> m (TT (t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (t x)
e
      Right Bool
True -> do
        TT (t x)
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
z
        TT (t x) -> m (TT (t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t x) -> m (TT (t x))) -> TT (t x) -> m (TT (t x))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (t x)
-> [Tree PE]
-> Either (TT (t x)) (t x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" p failed") TT (t x)
pp [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
bb] of
          Left TT (t x)
e -> TT (t x)
e
          Right t x
p -> POpts -> TT (t x) -> String -> [Tree PE] -> TT (t x)
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT (t x)
pp (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(False) Just " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> t x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts t x
p) [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
bb]
      Right Bool
False -> TT (t x) -> m (TT (t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t x) -> m (TT (t x))) -> TT (t x) -> m (TT (t x))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (t x) -> String -> [Tree PE] -> TT (t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t x -> Val (t x)
forall a. a -> Val a
Val t x
forall (f :: Type -> Type) a. Alternative f => f a
empty) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(True)") [TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
bb]


-- | similar to 'Control.Comonad.extract'

--

-- >>> pz @Extract (Nothing,Just 20)

-- Val (Just 20)

--

-- >>> pz @Extract (Identity 20)

-- Val 20

--

-- >>> pl @Extract (10,"hello")

-- Present "hello" (Extract "hello" | (10,"hello"))

-- Val "hello"

--

data Extract deriving Int -> Extract -> ShowS
[Extract] -> ShowS
Extract -> String
(Int -> Extract -> ShowS)
-> (Extract -> String) -> ([Extract] -> ShowS) -> Show Extract
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Extract] -> ShowS
$cshowList :: [Extract] -> ShowS
show :: Extract -> String
$cshow :: Extract -> String
showsPrec :: Int -> Extract -> ShowS
$cshowsPrec :: Int -> Extract -> ShowS
Show
instance ( Show (t a)
         , Show a
         , Comonad t
         ) => P Extract (t a) where
  type PP Extract (t a) = a
  eval :: proxy Extract -> POpts -> t a -> m (TT (PP Extract (t a)))
eval proxy Extract
_ POpts
opts t a
ta =
    let msg0 :: String
msg0 = String
"Extract"
        d :: a
d = t a -> a
forall (w :: Type -> Type) a. Comonad w => w a -> a
extract t a
ta
    in TT a -> m (TT a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT a -> m (TT a)) -> TT a -> m (TT a)
forall a b. (a -> b) -> a -> b
$ POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (a -> Val a
forall a. a -> Val a
Val a
d) (POpts -> String -> a -> t a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 a
d t a
ta) []

-- | similar to 'Control.Comonad.duplicate'

--

-- >>> pz @Duplicate (20,"abc")

-- Val (20,(20,"abc"))

--

data Duplicate deriving Int -> Duplicate -> ShowS
[Duplicate] -> ShowS
Duplicate -> String
(Int -> Duplicate -> ShowS)
-> (Duplicate -> String)
-> ([Duplicate] -> ShowS)
-> Show Duplicate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Duplicate] -> ShowS
$cshowList :: [Duplicate] -> ShowS
show :: Duplicate -> String
$cshow :: Duplicate -> String
showsPrec :: Int -> Duplicate -> ShowS
$cshowsPrec :: Int -> Duplicate -> ShowS
Show

instance ( Show (t a)
         , Show (t (t a))
         , Comonad t
         ) => P Duplicate (t a) where
  type PP Duplicate (t a) = t (t a)
  eval :: proxy Duplicate -> POpts -> t a -> m (TT (PP Duplicate (t a)))
eval proxy Duplicate
_ POpts
opts t a
ta =
    let msg0 :: String
msg0 = String
"Duplicate"
        d :: t (t a)
d = t a -> t (t a)
forall (w :: Type -> Type) a. Comonad w => w a -> w (w a)
duplicate t a
ta
    in TT (t (t a)) -> m (TT (t (t a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t (t a)) -> m (TT (t (t a))))
-> TT (t (t a)) -> m (TT (t (t a)))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (t (t a)) -> String -> [Tree PE] -> TT (t (t a))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t (t a) -> Val (t (t a))
forall a. a -> Val a
Val t (t a)
d) (POpts -> String -> t (t a) -> t a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 t (t a)
d t a
ta) []

-- | similar to 'Control.Monad.join'

--

-- >>> pz @Join (Just (Just 20))

-- Val (Just 20)

--

-- >>> pz @Join ["ab","cd","","ef"]

-- Val "abcdef"

--

data Join deriving Int -> Join -> ShowS
[Join] -> ShowS
Join -> String
(Int -> Join -> ShowS)
-> (Join -> String) -> ([Join] -> ShowS) -> Show Join
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Join] -> ShowS
$cshowList :: [Join] -> ShowS
show :: Join -> String
$cshow :: Join -> String
showsPrec :: Int -> Join -> ShowS
$cshowsPrec :: Int -> Join -> ShowS
Show

instance ( Show (t (t a))
         , Show (t a)
         , Monad t
         ) => P Join (t (t a)) where
  type PP Join (t (t a)) = t a
  eval :: proxy Join -> POpts -> t (t a) -> m (TT (PP Join (t (t a))))
eval proxy Join
_ POpts
opts t (t a)
tta =
    let msg0 :: String
msg0 = String
"Join"
        d :: t a
d = t (t a) -> t a
forall (m :: Type -> Type) a. Monad m => m (m a) -> m a
join t (t a)
tta
    in TT (t a) -> m (TT (t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t a) -> m (TT (t a))) -> TT (t a) -> m (TT (t a))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (t a) -> String -> [Tree PE] -> TT (t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t a -> Val (t a)
forall a. a -> Val a
Val t a
d) (POpts -> String -> t a -> t (t a) -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 t a
d t (t a)
tta) []

-- | function application for pure functions appearing on the rhs: similar to 'GHC.Base.$'

--

-- >>> :m + Text.Show.Functions

-- >>> pz @(Fst $$ Snd) ((*16),4)

-- Val 64

--

-- >>> pz @(Id $$ "def") ("abc"<>)

-- Val "abcdef"

--

-- >>> pz @(Id $$ 12) (*13)

-- Val 156

--

-- >>> pz @(Id $$ 7 $$ 3) (*)

-- Val 21

--

-- >>> pz @(Id $$ 7 $$ 3) (,)

-- Val (7,3)

--

-- >>> pz @(Id $$ "abc" $$ 'True) (,)

-- Val ("abc",True)

--

-- >>> pz @(Id $$ "asdf" $$ 99 $$ C "A") (,,)

-- Val ("asdf",99,'A')

--

-- >>> (fmap.fmap) ($ 9999) $ pz @Id (*33)

-- Val 329967

--

-- >>> (fmap.fmap) ($ 9999) $ pz @(Id $$ 1 $$ 'True) (,,)

-- Val (1,True,9999)

--

-- >>> (fmap.fmap.fmap) ($ 8) $ pz @'("xxx",Id) (*33)

-- Val ("xxx",264)

--

-- >>> pz @('True $& 4 $& Id $$ "aa") (,,)

-- Val (4,True,"aa")

--

-- >>> pz @((Id $$ "abc" $$ Wrap (SG.Sum _) 14) >> Id <> Id) These

-- Val (These "abcabc" (Sum {getSum = 28}))

--

data p $$ q deriving Int -> (p $$ q) -> ShowS
[p $$ q] -> ShowS
(p $$ q) -> String
(Int -> (p $$ q) -> ShowS)
-> ((p $$ q) -> String) -> ([p $$ q] -> ShowS) -> Show (p $$ q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p $$ q) -> ShowS
forall k (p :: k) k (q :: k). [p $$ q] -> ShowS
forall k (p :: k) k (q :: k). (p $$ q) -> String
showList :: [p $$ q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p $$ q] -> ShowS
show :: (p $$ q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p $$ q) -> String
showsPrec :: Int -> (p $$ q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p $$ q) -> ShowS
Show
infixl 0 $$

instance ( P p x
         , P q x
         , PP p x ~ (a -> b)
         , FnT (PP p x) ~ b
         , PP q x ~ a
         , Show a
         , Show b
         ) => P (p $$ q) x where
  type PP (p $$ q) x = FnT (PP p x)
  eval :: proxy (p $$ q) -> POpts -> x -> m (TT (PP (p $$ q) x))
eval proxy (p $$ q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"($$)"
    Either (TT b) (a -> b, a, TT (a -> b), TT a)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT b) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    TT b -> m (TT b)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT b -> m (TT b)) -> TT b -> m (TT b)
forall a b. (a -> b) -> a -> b
$ case Either (TT b) (a -> b, a, TT (a -> b), TT a)
lr of
      Left TT b
e -> TT b
e
      Right (a -> b
p,a
q,TT (a -> b)
pp,TT a
qq) ->
        let d :: b
d = a -> b
p a
q
        in POpts -> Val b -> String -> [Tree PE] -> TT b
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (b -> Val b
forall a. a -> Val a
Val b
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> b -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts b
d) [TT (a -> b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (a -> b)
pp, TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
qq]

-- reify this so we can combine (type synonyms dont work as well)


-- | flipped function application for expressions: similar to 'Control.Lens.&'

--

-- >>> :m + Text.Show.Functions

-- >>> pz @(Snd $& Fst) ((*16),4)

-- Val 64

--

-- >>> pz @("def" $& Id) ("abc"<>)

-- Val "abcdef"

--

-- >>> pz @('True $& 4 $& Id) (,)

-- Val (4,True)

--

data q $& p deriving Int -> (q $& p) -> ShowS
[q $& p] -> ShowS
(q $& p) -> String
(Int -> (q $& p) -> ShowS)
-> ((q $& p) -> String) -> ([q $& p] -> ShowS) -> Show (q $& p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (q :: k) k (p :: k). Int -> (q $& p) -> ShowS
forall k (q :: k) k (p :: k). [q $& p] -> ShowS
forall k (q :: k) k (p :: k). (q $& p) -> String
showList :: [q $& p] -> ShowS
$cshowList :: forall k (q :: k) k (p :: k). [q $& p] -> ShowS
show :: (q $& p) -> String
$cshow :: forall k (q :: k) k (p :: k). (q $& p) -> String
showsPrec :: Int -> (q $& p) -> ShowS
$cshowsPrec :: forall k (q :: k) k (p :: k). Int -> (q $& p) -> ShowS
Show
-- flips the args eg a & b & (,) = (b,a)

infixr 1 $&

instance ( P p x
         , P q x
         , PP p x ~ (a -> b)
         , FnT (PP p x) ~ b
         , PP q x ~ a
         , Show a
         , Show b
         ) => P (q $& p) x where
  type PP (q $& p) x = FnT (PP p x)
  eval :: proxy (q $& p) -> POpts -> x -> m (TT (PP (q $& p) x))
eval proxy (q $& p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"($&)"
    Either (TT b) (a -> b, a, TT (a -> b), TT a)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT b) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x []
    TT b -> m (TT b)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT b -> m (TT b)) -> TT b -> m (TT b)
forall a b. (a -> b) -> a -> b
$ case Either (TT b) (a -> b, a, TT (a -> b), TT a)
lr of
      Left TT b
e -> TT b
e
      Right (a -> b
p,a
q,TT (a -> b)
pp,TT a
qq) ->
        let d :: b
d = a -> b
p a
q
        in POpts -> Val b -> String -> [Tree PE] -> TT b
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (b -> Val b
forall a. a -> Val a
Val b
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> b -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts b
d) [TT (a -> b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (a -> b)
pp, TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
qq]

-- | similar to 'sequenceA'

--

-- >>> pz @Sequence [Just 10, Just 20, Just 30]

-- Val (Just [10,20,30])

--

-- >>> pz @Sequence [Just 10, Just 20, Just 30, Nothing, Just 40]

-- Val Nothing

--

data Sequence deriving Int -> Sequence -> ShowS
[Sequence] -> ShowS
Sequence -> String
(Int -> Sequence -> ShowS)
-> (Sequence -> String) -> ([Sequence] -> ShowS) -> Show Sequence
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sequence] -> ShowS
$cshowList :: [Sequence] -> ShowS
show :: Sequence -> String
$cshow :: Sequence -> String
showsPrec :: Int -> Sequence -> ShowS
$cshowsPrec :: Int -> Sequence -> ShowS
Show

instance ( Show (f (t a))
         , Show (t (f a))
         , Traversable t
         , Applicative f
         ) => P Sequence (t (f a)) where
  type PP Sequence (t (f a)) = f (t a)
  eval :: proxy Sequence
-> POpts -> t (f a) -> m (TT (PP Sequence (t (f a))))
eval proxy Sequence
_ POpts
opts t (f a)
tfa =
     let msg :: String
msg = String
"Sequence"
         d :: f (t a)
d = t (f a) -> f (t a)
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA t (f a)
tfa
     in TT (f (t a)) -> m (TT (f (t a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (f (t a)) -> m (TT (f (t a))))
-> TT (f (t a)) -> m (TT (f (t a)))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (f (t a)) -> String -> [Tree PE] -> TT (f (t a))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (f (t a) -> Val (f (t a))
forall a. a -> Val a
Val f (t a)
d) (String
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> f (t a) -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts f (t a)
d String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> t (f a) -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " t (f a)
tfa) []

-- | like 'traverse'

--

-- >>> pl @(Traverse (If (Gt 3) (Pure Maybe Id) (EmptyT Maybe _))) [1..5]

-- Present Nothing ((>>) Nothing | {Sequence Nothing | [Nothing,Nothing,Nothing,Just 4,Just 5]})

-- Val Nothing

--

-- >>> pl @(Traverse (MaybeBool (Le 3) Id)) [1..5]

-- Present Nothing ((>>) Nothing | {Sequence Nothing | [Just 1,Just 2,Just 3,Nothing,Nothing]})

-- Val Nothing

--

-- >>> pl @(Traverse (If (Gt 0) (Pure Maybe Id) (EmptyT Maybe _))) [1..5]

-- Present Just [1,2,3,4,5] ((>>) Just [1,2,3,4,5] | {Sequence Just [1,2,3,4,5] | [Just 1,Just 2,Just 3,Just 4,Just 5]})

-- Val (Just [1,2,3,4,5])

--

-- >>> pl @(Traverse (If (Gt 0) (Pure Maybe Id) (MkNothing _))) [1..5]

-- Present Just [1,2,3,4,5] ((>>) Just [1,2,3,4,5] | {Sequence Just [1,2,3,4,5] | [Just 1,Just 2,Just 3,Just 4,Just 5]})

-- Val (Just [1,2,3,4,5])

--

-- >>> pl @(Traverse (MaybeBool (Id >= 0) Id)) [1..5]

-- Present Just [1,2,3,4,5] ((>>) Just [1,2,3,4,5] | {Sequence Just [1,2,3,4,5] | [Just 1,Just 2,Just 3,Just 4,Just 5]})

-- Val (Just [1,2,3,4,5])

--

-- >>> pl @(Traverse (MaybeBool (Id <= 3) Id)) [1..5]

-- Present Nothing ((>>) Nothing | {Sequence Nothing | [Just 1,Just 2,Just 3,Nothing,Nothing]})

-- Val Nothing

--

data Traverse p deriving Int -> Traverse p -> ShowS
[Traverse p] -> ShowS
Traverse p -> String
(Int -> Traverse p -> ShowS)
-> (Traverse p -> String)
-> ([Traverse p] -> ShowS)
-> Show (Traverse p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Traverse p -> ShowS
forall k (p :: k). [Traverse p] -> ShowS
forall k (p :: k). Traverse p -> String
showList :: [Traverse p] -> ShowS
$cshowList :: forall k (p :: k). [Traverse p] -> ShowS
show :: Traverse p -> String
$cshow :: forall k (p :: k). Traverse p -> String
showsPrec :: Int -> Traverse p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Traverse p -> ShowS
Show
type TraverseT p = FMap p >> Sequence

instance P (TraverseT p) x => P (Traverse p) x where
  type PP (Traverse p) x = PP (TraverseT p) x
  eval :: proxy (Traverse p) -> POpts -> x -> m (TT (PP (Traverse p) x))
eval proxy (Traverse p)
_ = Proxy (TraverseT p) -> POpts -> x -> m (TT (PP (TraverseT p) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (TraverseT p)
forall k (t :: k). Proxy t
Proxy @(TraverseT p))

-- | just run the effect ignoring the result passing the original value through

--

--   for example for use with Stdout so it doesnt interfere with the @a@ on the rhs unless it fails

data Skip p deriving Int -> Skip p -> ShowS
[Skip p] -> ShowS
Skip p -> String
(Int -> Skip p -> ShowS)
-> (Skip p -> String) -> ([Skip p] -> ShowS) -> Show (Skip p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Skip p -> ShowS
forall k (p :: k). [Skip p] -> ShowS
forall k (p :: k). Skip p -> String
showList :: [Skip p] -> ShowS
$cshowList :: forall k (p :: k). [Skip p] -> ShowS
show :: Skip p -> String
$cshow :: forall k (p :: k). Skip p -> String
showsPrec :: Int -> Skip p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Skip p -> ShowS
Show

instance ( Show (PP p a)
         , P p a
         ) => P (Skip p) a where
  type PP (Skip p) a = a
  eval :: proxy (Skip p) -> POpts -> a -> m (TT (PP (Skip p) a))
eval proxy (Skip p)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"Skip"
    TT (PP p a)
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
    TT a -> m (TT a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT a -> m (TT a)) -> TT a -> m (TT a)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT a) (PP p a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p a)
pp [] of
      Left TT a
e -> TT a
e
      Right PP p a
p -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (a -> Val a
forall a. a -> Val a
Val a
a) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP p a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p a
p) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]

-- | run @p@ for the effect and then run @q@ using that original value

data p |> q deriving Int -> (p |> q) -> ShowS
[p |> q] -> ShowS
(p |> q) -> String
(Int -> (p |> q) -> ShowS)
-> ((p |> q) -> String) -> ([p |> q] -> ShowS) -> Show (p |> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p |> q) -> ShowS
forall k (p :: k) k (q :: k). [p |> q] -> ShowS
forall k (p :: k) k (q :: k). (p |> q) -> String
showList :: [p |> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p |> q] -> ShowS
show :: (p |> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p |> q) -> String
showsPrec :: Int -> (p |> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p |> q) -> ShowS
Show
type SkipLT p q = Skip p >> q
infixr 1 |>

instance P (SkipLT p q) x => P (p |> q) x where
  type PP (p |> q) x = PP (SkipLT p q) x
  eval :: proxy (p |> q) -> POpts -> x -> m (TT (PP (p |> q) x))
eval proxy (p |> q)
_ = Proxy (SkipLT p q) -> POpts -> x -> m (TT (PP (SkipLT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (SkipLT p q)
forall k (t :: k). Proxy t
Proxy @(SkipLT p q))

-- | run run @p@ and then @q@ for the effect but using the result from @p@

data p >| q deriving Int -> (p >| q) -> ShowS
[p >| q] -> ShowS
(p >| q) -> String
(Int -> (p >| q) -> ShowS)
-> ((p >| q) -> String) -> ([p >| q] -> ShowS) -> Show (p >| q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p >| q) -> ShowS
forall k (p :: k) k (q :: k). [p >| q] -> ShowS
forall k (p :: k) k (q :: k). (p >| q) -> String
showList :: [p >| q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p >| q] -> ShowS
show :: (p >| q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p >| q) -> String
showsPrec :: Int -> (p >| q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p >| q) -> ShowS
Show
type SkipRT p q = p >> Skip q
infixr 1 >|

instance P (SkipRT p q) x => P (p >| q) x where
  type PP (p >| q) x = PP (SkipRT p q) x
  eval :: proxy (p >| q) -> POpts -> x -> m (TT (PP (p >| q) x))
eval proxy (p >| q)
_ = Proxy (SkipRT p q) -> POpts -> x -> m (TT (PP (SkipRT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (SkipRT p q)
forall k (t :: k). Proxy t
Proxy @(SkipRT p q))

-- | run both @p@ and @q@ for their effects but ignoring the results

data p >|> q deriving Int -> (p >|> q) -> ShowS
[p >|> q] -> ShowS
(p >|> q) -> String
(Int -> (p >|> q) -> ShowS)
-> ((p >|> q) -> String) -> ([p >|> q] -> ShowS) -> Show (p >|> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p >|> q) -> ShowS
forall k (p :: k) k (q :: k). [p >|> q] -> ShowS
forall k (p :: k) k (q :: k). (p >|> q) -> String
showList :: [p >|> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p >|> q] -> ShowS
show :: (p >|> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p >|> q) -> String
showsPrec :: Int -> (p >|> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p >|> q) -> ShowS
Show
type SkipBothT p q = Skip p >> Skip q
infixr 1 >|>

instance P (SkipBothT p q) x => P (p >|> q) x where
  type PP (p >|> q) x = PP (SkipBothT p q) x
  eval :: proxy (p >|> q) -> POpts -> x -> m (TT (PP (p >|> q) x))
eval proxy (p >|> q)
_ = Proxy (SkipBothT p q)
-> POpts -> x -> m (TT (PP (SkipBothT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (SkipBothT p q)
forall k (t :: k). Proxy t
Proxy @(SkipBothT p q))

-- | run an expression @p@ and on failure run @q@

--

-- >>> pz @(Catch Succ (Fst >> Second (ShowP Id) >> PrintT "%s %s" Id >> 'LT)) GT

-- Val LT

--

-- >>> pz @(Len > 1 && Catch (Id !! 3 == 66) 'False) [1,2]

-- Val False

--

-- >>> pl @(Catch (Resplit "\\d+(") (Snd >> MEmptyP)) "123"

-- Present [] (Catch caught exception[Regex failed to compile])

-- Val []

--

-- >>> pl @(Catch OneP 99) [10,11]

-- Present 99 (Catch caught exception[OneP:expected one element(2)])

-- Val 99

--

-- >>> pl @(Catch OneP 99) [10]

-- Present 10 (Catch did not fire)

-- Val 10

--

-- >>> pl @(Catch OneP 'True) [False]

-- Present False (Catch did not fire)

-- Val False

--

-- >>> pl @(Catch OneP 'False) [True,True,False]

-- False (Catch caught exception[OneP:expected one element(3)])

-- Val False

--

-- >>> pl @(Catch OneP 'True) []

-- True (Catch caught exception[OneP:expected one element(empty)])

-- Val True

--

data Catch p q deriving Int -> Catch p q -> ShowS
[Catch p q] -> ShowS
Catch p q -> String
(Int -> Catch p q -> ShowS)
-> (Catch p q -> String)
-> ([Catch p q] -> ShowS)
-> Show (Catch p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Catch p q -> ShowS
forall k (p :: k) k (q :: k). [Catch p q] -> ShowS
forall k (p :: k) k (q :: k). Catch p q -> String
showList :: [Catch p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Catch p q] -> ShowS
show :: Catch p q -> String
$cshow :: forall k (p :: k) k (q :: k). Catch p q -> String
showsPrec :: Int -> Catch p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Catch p q -> ShowS
Show

-- | run an expression @p@ and on failure print a custom error @s@ using the error string and the input value

--

-- >>> pz @(Catch' Succ (Second (ShowP Id) >> PrintT "%s %s" Id)) GT

-- Fail "Succ IO e=Prelude.Enum.Ordering.succ: bad argument GT"

--

-- >>> pz @(Catch' Succ (Second (ShowP Id) >> PrintT "%s %s" Id)) LT

-- Val EQ

--

-- >>> pl @(Catch' (FailT Int "someval") (PrintT "msg=%s caught(%03d)" Id)) 44

-- Error msg=someval caught(044) (Catch default condition failed)

-- Fail "msg=someval caught(044)"

--

-- >>> pl @(Catch' OneP (Second (ShowP Id) >> PrintT "msg=%s caught(%s)" Id)) [10,12,13]

-- Error msg=OneP:expected one element(3) caught([10,12,13]) (Catch default condition failed)

-- Fail "msg=OneP:expected one element(3) caught([10,12,13])"

--

-- >>> pl @(Catch' OneP (PrintT "msg=%s caught(%s)" (Second (ShowP Id)))) [10]

-- Present 10 (Catch did not fire)

-- Val 10

--

-- >>> pl @(Catch' OneP (PrintT "msg=%s err s=%s" (Second (ShowP Id)))) [10,11]

-- Error msg=OneP:expected one element(2) err s=[10,11] (Catch default condition failed)

-- Fail "msg=OneP:expected one element(2) err s=[10,11]"

--

data Catch' p s deriving Int -> Catch' p s -> ShowS
[Catch' p s] -> ShowS
Catch' p s -> String
(Int -> Catch' p s -> ShowS)
-> (Catch' p s -> String)
-> ([Catch' p s] -> ShowS)
-> Show (Catch' p s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (s :: k). Int -> Catch' p s -> ShowS
forall k (p :: k) k (s :: k). [Catch' p s] -> ShowS
forall k (p :: k) k (s :: k). Catch' p s -> String
showList :: [Catch' p s] -> ShowS
$cshowList :: forall k (p :: k) k (s :: k). [Catch' p s] -> ShowS
show :: Catch' p s -> String
$cshow :: forall k (p :: k) k (s :: k). Catch' p s -> String
showsPrec :: Int -> Catch' p s -> ShowS
$cshowsPrec :: forall k (p :: k) k (s :: k). Int -> Catch' p s -> ShowS
Show
type CatchT' p s = Catch p (FailCatchT s) -- eg set eg s=PrintF "%d" Id or PrintF "%s" (ShowP Id)

type FailCatchT s = Fail (Snd >> UnproxyT) (Fst >> s)

instance P (CatchT' p s) x => P (Catch' p s) x where
  type PP (Catch' p s) x = PP (CatchT' p s) x
  eval :: proxy (Catch' p s) -> POpts -> x -> m (TT (PP (Catch' p s) x))
eval proxy (Catch' p s)
_ = Proxy (CatchT' p s) -> POpts -> x -> m (TT (PP (CatchT' p s) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (CatchT' p s)
forall k (t :: k). Proxy t
Proxy @(CatchT' p s))

instance ( P p x
         , P q ((String, x)
         , Proxy (PP p x))
         , PP p x ~ PP q ((String, x), Proxy (PP p x))
         ) => P (Catch p q) x where
  type PP (Catch p q) x = PP p x
  eval :: proxy (Catch p q) -> POpts -> x -> m (TT (PP (Catch p q) x))
eval proxy (Catch p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"Catch"
    TT (PP q ((String, x), Proxy (PP p x)))
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    case Inline
-> POpts
-> String
-> TT (PP q ((String, x), Proxy (PP p x)))
-> [Tree PE]
-> Either (TT Any) (PP q ((String, x), Proxy (PP p x)))
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP q ((String, x), Proxy (PP p x)))
pp [] of
      Left TT Any
p -> do
         let emsg :: String
emsg = TT Any
p TT Any -> Getting String (TT Any) String -> String
forall s a. s -> Getting a s a -> a
^. (Val Any -> Const String (Val Any))
-> TT Any -> Const String (TT Any)
forall a b. Lens (TT a) (TT b) (Val a) (Val b)
ttVal ((Val Any -> Const String (Val Any))
 -> TT Any -> Const String (TT Any))
-> ((String -> Const String String)
    -> Val Any -> Const String (Val Any))
-> Getting String (TT Any) String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traversing (->) (Const String) (Val Any) (Val Any) String String
-> (String -> Const String String)
-> Val Any
-> Const String (Val Any)
forall (p :: Type -> Type -> Type) (f :: Type -> Type) s t a.
(HasCallStack, Conjoined p, Functor f) =>
Traversing p f s t a a -> Over p f s t a a
singular Traversing (->) (Const String) (Val Any) (Val Any) String String
forall a. Prism' (Val a) String
_Fail -- extract the Fail string and push it back into the fail case

         TT (PP q ((String, x), Proxy (PP p x)))
qq <- Proxy q
-> POpts
-> ((String, x), Proxy (PP q ((String, x), Proxy (PP p x))))
-> m (TT
        (PP q ((String, x), Proxy (PP q ((String, x), Proxy (PP p x))))))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts ((String
emsg, x
x), Proxy (PP p x)
forall k (t :: k). Proxy t
Proxy @(PP p x))
         TT (PP q ((String, x), Proxy (PP p x)))
-> m (TT (PP q ((String, x), Proxy (PP p x))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q ((String, x), Proxy (PP p x)))
 -> m (TT (PP q ((String, x), Proxy (PP p x)))))
-> TT (PP q ((String, x), Proxy (PP p x)))
-> m (TT (PP q ((String, x), Proxy (PP p x))))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP q ((String, x), Proxy (PP p x)))
-> [Tree PE]
-> Either
     (TT (PP q ((String, x), Proxy (PP p x))))
     (PP q ((String, x), Proxy (PP p x)))
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" default condition failed") TT (PP q ((String, x), Proxy (PP p x)))
qq [TT (PP q ((String, x), Proxy (PP p x))) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q ((String, x), Proxy (PP p x)))
pp] of
            Left TT (PP q ((String, x), Proxy (PP p x)))
e1 -> TT (PP q ((String, x), Proxy (PP p x)))
e1
            Right PP q ((String, x), Proxy (PP p x))
_ -> POpts
-> TT (PP q ((String, x), Proxy (PP p x)))
-> String
-> [Tree PE]
-> TT (PP q ((String, x), Proxy (PP p x)))
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT (PP q ((String, x), Proxy (PP p x)))
qq (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" caught exception[" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
emsg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]") [TT (PP q ((String, x), Proxy (PP p x))) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q ((String, x), Proxy (PP p x)))
pp]
      Right PP q ((String, x), Proxy (PP p x))
_ -> TT (PP q ((String, x), Proxy (PP p x)))
-> m (TT (PP q ((String, x), Proxy (PP p x))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q ((String, x), Proxy (PP p x)))
 -> m (TT (PP q ((String, x), Proxy (PP p x)))))
-> TT (PP q ((String, x), Proxy (PP p x)))
-> m (TT (PP q ((String, x), Proxy (PP p x))))
forall a b. (a -> b) -> a -> b
$ POpts
-> TT (PP q ((String, x), Proxy (PP p x)))
-> String
-> [Tree PE]
-> TT (PP q ((String, x), Proxy (PP p x)))
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT (PP q ((String, x), Proxy (PP p x)))
pp (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" did not fire") []

-- | compose simple functions

--

-- >>> pl @(Dot '[L3,L2,L1] Id) ((1,(2,9,10)),(3,4))

-- Present 10 (Thd 10 | (2,9,10))

-- Val 10

--

data Dot (ps :: [Type -> Type]) (q :: Type) deriving Int -> Dot ps q -> ShowS
[Dot ps q] -> ShowS
Dot ps q -> String
(Int -> Dot ps q -> ShowS)
-> (Dot ps q -> String) -> ([Dot ps q] -> ShowS) -> Show (Dot ps q)
forall (ps :: [Type -> Type]) q. Int -> Dot ps q -> ShowS
forall (ps :: [Type -> Type]) q. [Dot ps q] -> ShowS
forall (ps :: [Type -> Type]) q. Dot ps q -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dot ps q] -> ShowS
$cshowList :: forall (ps :: [Type -> Type]) q. [Dot ps q] -> ShowS
show :: Dot ps q -> String
$cshow :: forall (ps :: [Type -> Type]) q. Dot ps q -> String
showsPrec :: Int -> Dot ps q -> ShowS
$cshowsPrec :: forall (ps :: [Type -> Type]) q. Int -> Dot ps q -> ShowS
Show
instance (P (DotExpandT ps q) a) => P (Dot ps q) a where
  type PP (Dot ps q) a = PP (DotExpandT ps q) a
  eval :: proxy (Dot ps q) -> POpts -> a -> m (TT (PP (Dot ps q) a))
eval proxy (Dot ps q)
_ = Proxy (DotExpandT ps q)
-> POpts -> a -> m (TT (PP (DotExpandT ps q) a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (DotExpandT ps q)
forall k (t :: k). Proxy t
Proxy @(DotExpandT ps q))

-- | calculates the return type for 'Dot'

type family DotExpandT (ps :: [Type -> Type]) (q :: Type) :: Type where
  DotExpandT '[] _ = GL.TypeError ('GL.Text "'[] invalid: requires at least one predicate in the list")
  DotExpandT '[p] q = p $ q
  DotExpandT (p ': p1 ': ps) q = p $ DotExpandT (p1 ': ps) q

-- | reversed version of 'Dot'

--

-- >>> pl @(RDot '[L1,L2,L3] Id) ((1,(2,9,10)),(3,4))

-- Present 10 (Thd 10 | (2,9,10))

-- Val 10

--

-- >>> pl @(RDot '[L1,L2] Id) (('a',2),(True,"zy"))

-- Present 2 (Snd 2 | ('a',2))

-- Val 2

--

data RDot (ps :: [Type -> Type]) (q :: Type) deriving Int -> RDot ps q -> ShowS
[RDot ps q] -> ShowS
RDot ps q -> String
(Int -> RDot ps q -> ShowS)
-> (RDot ps q -> String)
-> ([RDot ps q] -> ShowS)
-> Show (RDot ps q)
forall (ps :: [Type -> Type]) q. Int -> RDot ps q -> ShowS
forall (ps :: [Type -> Type]) q. [RDot ps q] -> ShowS
forall (ps :: [Type -> Type]) q. RDot ps q -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RDot ps q] -> ShowS
$cshowList :: forall (ps :: [Type -> Type]) q. [RDot ps q] -> ShowS
show :: RDot ps q -> String
$cshow :: forall (ps :: [Type -> Type]) q. RDot ps q -> String
showsPrec :: Int -> RDot ps q -> ShowS
$cshowsPrec :: forall (ps :: [Type -> Type]) q. Int -> RDot ps q -> ShowS
Show
instance P (RDotExpandT ps q) a => P (RDot ps q) a where
  type PP (RDot ps q) a = PP (RDotExpandT ps q) a
  eval :: proxy (RDot ps q) -> POpts -> a -> m (TT (PP (RDot ps q) a))
eval proxy (RDot ps q)
_ = Proxy (RDotExpandT ps q)
-> POpts -> a -> m (TT (PP (RDotExpandT ps q) a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (RDotExpandT ps q)
forall k (t :: k). Proxy t
Proxy @(RDotExpandT ps q))

-- | calculates the return type for 'RDot'

type family RDotExpandT (ps :: [Type -> Type]) (q :: Type) :: Type where
  RDotExpandT '[] _ = GL.TypeError ('GL.Text "'[] invalid: requires at least one predicate in the list")
  RDotExpandT '[p] q = p $ q
  RDotExpandT (p ': p1 ': ps) q = RDotExpandT (p1 ': ps) (p $ q)

-- | similar to 'const':types dont need to match on rhs!

--

-- >>> pl @(RDot '[L1,L2,L3,K "xxx"] Id) 12345

-- Present "xxx" (K '"xxx")

-- Val "xxx"

--

-- >>> pl @(RDot '[L1,L2,L3,K '("abc",Id)] Id) ()

-- Present ("abc",()) (K '("abc",()))

-- Val ("abc",())

--

-- >>> pl @(Dot '[K "skip",L6,Lift Dup,Lift Succ] Id) ()

-- Present "skip" (K '"skip")

-- Val "skip"

--

-- >>> pl @(L3 $ L2 $ L1 $ K Id "dud") ((1,("X",9,'a')),(3,4))

-- Present 'a' (Thd 'a' | ("X",9,'a'))

-- Val 'a'

--

-- >>> pl @((L3 $ L2 $ L1 $ K Id "dud") >> Pred) ((1,("X",9,'a')),(3,4))

-- Present '`' ((>>) '`' | {Pred '`' | 'a'})

-- Val '`'

--

-- >>> pl @(K "ss" $ L3 $ L3 $ Fst) ()

-- Present "ss" (K '"ss")

-- Val "ss"

--

data K (p :: k) (q :: k1) deriving Int -> K p q -> ShowS
[K p q] -> ShowS
K p q -> String
(Int -> K p q -> ShowS)
-> (K p q -> String) -> ([K p q] -> ShowS) -> Show (K p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k1 (q :: k1). Int -> K p q -> ShowS
forall k (p :: k) k1 (q :: k1). [K p q] -> ShowS
forall k (p :: k) k1 (q :: k1). K p q -> String
showList :: [K p q] -> ShowS
$cshowList :: forall k (p :: k) k1 (q :: k1). [K p q] -> ShowS
show :: K p q -> String
$cshow :: forall k (p :: k) k1 (q :: k1). K p q -> String
showsPrec :: Int -> K p q -> ShowS
$cshowsPrec :: forall k (p :: k) k1 (q :: k1). Int -> K p q -> ShowS
Show
instance P p a => P (K p q) a where
  type PP (K p q) a = PP p a
  eval :: proxy (K p q) -> POpts -> a -> m (TT (PP (K p q) a))
eval proxy (K p q)
_ = Proxy (MsgI "K " p) -> POpts -> a -> m (TT (PP (MsgI "K " p) a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (MsgI "K " p)
forall k (t :: k). Proxy t
Proxy @(MsgI "K " p))

-- useful only when you need an extra arg function or p is a constant or p and Id can be the same

-- also useful if you dont want to have parens cos of >>

-- Lift Rescan Fst wont work as Id and Fst are different: how can regex pattern be the same as the value you are matching against!

-- | Lift a no arg Adt to a function of one argument (for use with 'Dot' and 'RDot')

--

-- >>> pl @(Lift Len Snd) (True,"abcdef")

-- Present 6 ((>>) 6 | {Len 6 | "abcdef"})

-- Val 6

--

data Lift p q deriving Int -> Lift p q -> ShowS
[Lift p q] -> ShowS
Lift p q -> String
(Int -> Lift p q -> ShowS)
-> (Lift p q -> String) -> ([Lift p q] -> ShowS) -> Show (Lift p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Lift p q -> ShowS
forall k (p :: k) k (q :: k). [Lift p q] -> ShowS
forall k (p :: k) k (q :: k). Lift p q -> String
showList :: [Lift p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Lift p q] -> ShowS
show :: Lift p q -> String
$cshow :: forall k (p :: k) k (q :: k). Lift p q -> String
showsPrec :: Int -> Lift p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Lift p q -> ShowS
Show
type LiftT p q = q >> p

instance P (LiftT p q) x => P (Lift p q) x where
  type PP (Lift p q) x = PP (LiftT p q) x
  eval :: proxy (Lift p q) -> POpts -> x -> m (TT (PP (Lift p q) x))
eval proxy (Lift p q)
_ = Proxy (LiftT p q) -> POpts -> x -> m (TT (PP (LiftT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (LiftT p q)
forall k (t :: k). Proxy t
Proxy @(LiftT p q))

-- | similar to 'Data.Functor.<$>'

--

-- >>> pl @(FMap Succ) (Right 'a')

-- Present Right 'b' (FMap Succ 'b' | 'a')

-- Val (Right 'b')

--

-- >>> pl @(FMap Succ) (Left "Sf")

-- Present Left "Sf" (FMap <skipped>)

-- Val (Left "Sf")

--

-- >>> pz @(FMap (MkDay Id) >> Join) (Just (2020,01,01))

-- Val (Just 2020-01-01)

--

-- >>> pz @(FMap (MkDay Id) >> Join) (Just (2020,01,32))

-- Val Nothing

--

-- >>> pz @(FMap Succ) (Just LT)

-- Val (Just EQ)

--

-- >>> pz @(FMap Pred) (Just LT)

-- Fail "Pred IO e=Prelude.Enum.Ordering.pred: bad argument"

--

-- >>> pz @(FMap (ShowP Id)) (Just 10)

-- Val (Just "10")

--

-- >>> pan @(FMap $ FMap $ FMap Succ) [Just "abcdefG",Nothing,Just "X"]

-- P FMap FMap FMap Succ 'b' | Succ 'c' | Succ 'd' | Succ 'e' | Succ 'f' | Succ 'g' | Succ 'H' | FMap <skipped> | FMap FMap Succ 'Y'

-- |

-- +- P FMap FMap Succ 'b' | Succ 'c' | Succ 'd' | Succ 'e' | Succ 'f' | Succ 'g' | Succ 'H'

-- |  |

-- |  `- P FMap Succ 'b' | Succ 'c' | Succ 'd' | Succ 'e' | Succ 'f' | Succ 'g' | Succ 'H'

-- |     |

-- |     +- P Succ 'b'

-- |     |

-- |     +- P Succ 'c'

-- |     |

-- |     +- P Succ 'd'

-- |     |

-- |     +- P Succ 'e'

-- |     |

-- |     +- P Succ 'f'

-- |     |

-- |     +- P Succ 'g'

-- |     |

-- |     `- P Succ 'H'

-- |

-- +- P FMap <skipped>

-- |

-- `- P FMap FMap Succ 'Y'

--    |

--    `- P FMap Succ 'Y'

--       |

--       `- P Succ 'Y'

-- Val [Just "bcdefgH",Nothing,Just "Y"]

--

-- >>> pan @(FMap (FromEnum > 97)) "abc"

-- P FMap 97 > 97 | 98 > 97 | 99 > 97

-- |

-- +- False 97 > 97

-- |  |

-- |  +- P FromEnum 97

-- |  |

-- |  `- P '97

-- |

-- +- True 98 > 97

-- |  |

-- |  +- P FromEnum 98

-- |  |

-- |  `- P '97

-- |

-- `- True 99 > 97

--    |

--    +- P FromEnum 99

--    |

--    `- P '97

-- Val [False,True,True]

--

-- >>> pan @(FMap (FromEnum > 97 >> Id)) "abc"

-- P FMap (>>) False | (>>) True | (>>) True

-- |

-- +- P (>>) False

-- |  |

-- |  +- False 97 > 97

-- |  |  |

-- |  |  +- P FromEnum 97

-- |  |  |

-- |  |  `- P '97

-- |  |

-- |  `- P Id False

-- |

-- +- P (>>) True

-- |  |

-- |  +- True 98 > 97

-- |  |  |

-- |  |  +- P FromEnum 98

-- |  |  |

-- |  |  `- P '97

-- |  |

-- |  `- P Id True

-- |

-- `- P (>>) True

--    |

--    +- True 99 > 97

--    |  |

--    |  +- P FromEnum 99

--    |  |

--    |  `- P '97

--    |

--    `- P Id True

-- Val [False,True,True]

--

-- >>> pan @(FMap IdBool) (Just True)

-- P FMap IdBool

-- |

-- `- True IdBool

-- Val (Just True)

--

-- >>> pz @(FMap (Pure (Either String) Id)) [1,2,4]

-- Val [Right 1,Right 2,Right 4]

--

-- >>> pl @(FMap (Pure [] Id)) (Just 10)

-- Present Just [10] (FMap Pure [10] | 10)

-- Val (Just [10])

--

-- >>> pl @(FMap (Pure SG.Sum Id)) (Just 20)

-- Present Just (Sum {getSum = 20}) (FMap Pure Sum {getSum = 20} | 20)

-- Val (Just (Sum {getSum = 20}))

--

-- >>> pz @(FMap (Coerce (SG.Sum Integer))) [Identity (-13), Identity 4, Identity 99]

-- Val [Sum {getSum = -13},Sum {getSum = 4},Sum {getSum = 99}]

--

-- >>> pz @(FMap (Coerce (SG.Sum Integer))) (Just (Identity (-13)))

-- Val (Just (Sum {getSum = -13}))

--

-- >>> pz @(FMap (Coerce (SG.Sum Int))) (Nothing @(Identity Int))

-- Val Nothing

--

-- >>> pl @(FMap (Coerce (SG.Sum Int))) (Just (10 :: Int))

-- Present Just (Sum {getSum = 10}) (FMap Coerce Sum {getSum = 10} | 10)

-- Val (Just (Sum {getSum = 10}))

--

-- >>> pz @(Proxy Char >> FMap Succ) () ^!? acts . _Val . to typeRep

-- Just Char

--

data FMap p deriving Int -> FMap p -> ShowS
[FMap p] -> ShowS
FMap p -> String
(Int -> FMap p -> ShowS)
-> (FMap p -> String) -> ([FMap p] -> ShowS) -> Show (FMap p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> FMap p -> ShowS
forall k (p :: k). [FMap p] -> ShowS
forall k (p :: k). FMap p -> String
showList :: [FMap p] -> ShowS
$cshowList :: forall k (p :: k). [FMap p] -> ShowS
show :: FMap p -> String
$cshow :: forall k (p :: k). FMap p -> String
showsPrec :: Int -> FMap p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> FMap p -> ShowS
Show

instance ( Traversable n
         , P p a
         ) => P (FMap p) (n a) where
  type PP (FMap p) (n a) = n (PP p a)
  eval :: proxy (FMap p) -> POpts -> n a -> m (TT (PP (FMap p) (n a)))
eval proxy (FMap p)
_ POpts
opts n a
na = do
    let msg0 :: String
msg0 = String
"FMap"
    POpts
-> Proxy p -> String -> [Tree PE] -> n a -> m (TT (n (PP p a)))
forall k (m :: Type -> Type) (n :: Type -> Type) (p :: k) a.
(P p a, Traversable n, MonadEval m) =>
POpts
-> Proxy p -> String -> [Tree PE] -> n a -> m (TT (n (PP p a)))
_fmapImpl POpts
opts (Proxy p
forall k (t :: k). Proxy t
Proxy @p) String
msg0 [] n a
na

-- | similar to 'Data.Functor.<$>'

--

-- >>> pz @(Len <$> Snd) (1,Just "abcdef")

-- Val (Just 6)

--

-- >>> pz @(Len <$> (Id <> Id <> "extra" <$> Snd)) (1,Just "abcdef")

-- Val (Just 17)

--

-- >>> pz @(Len <$> (Id <> Id <> "extra" <$> Snd)) (1,Right "abcdef")

-- Val (Right 17)

--

-- >>> pz @(FMap $ FMap (Succ <$> Id)) (True,Just (These 12 'c'))

-- Val (True,Just (These 12 'd'))

--

-- >>> pz @(FMap (Second (Succ <$> Id))) [(True, (These 12 'c'))]

-- Val [(True,These 12 'd')]

--

data p <$> q deriving Int -> (p <$> q) -> ShowS
[p <$> q] -> ShowS
(p <$> q) -> String
(Int -> (p <$> q) -> ShowS)
-> ((p <$> q) -> String) -> ([p <$> q] -> ShowS) -> Show (p <$> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <$> q) -> ShowS
forall k (p :: k) k (q :: k). [p <$> q] -> ShowS
forall k (p :: k) k (q :: k). (p <$> q) -> String
showList :: [p <$> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <$> q] -> ShowS
show :: (p <$> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <$> q) -> String
showsPrec :: Int -> (p <$> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <$> q) -> ShowS
Show
infixl 4 <$>

instance ( Traversable n
         , P q a
         , P p b
         , PP q a ~ n b
         , PP p b ~ c
         ) => P (p <$> q) a where
  type PP (p <$> q) a = (ExtractTFromTA (PP q a)) (PP p (ExtractAFromTA (PP q a)))
  eval :: proxy (p <$> q) -> POpts -> a -> m (TT (PP (p <$> q) a))
eval proxy (p <$> q)
_ POpts
opts a
x = do
    let msg0 :: String
msg0 = String
"(<$>)"
    TT (n b)
qq <- Proxy q -> POpts -> a -> m (TT (PP q a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
x
    case Inline
-> POpts
-> String
-> TT (n b)
-> [Tree PE]
-> Either (TT (n c)) (n b)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (n b)
qq [] of
      Left TT (n c)
e -> TT (n c) -> m (TT (n c))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (n c)
e
      Right n b
q -> POpts
-> Proxy p -> String -> [Tree PE] -> n b -> m (TT (n (PP p b)))
forall k (m :: Type -> Type) (n :: Type -> Type) (p :: k) a.
(P p a, Traversable n, MonadEval m) =>
POpts
-> Proxy p -> String -> [Tree PE] -> n a -> m (TT (n (PP p a)))
_fmapImpl POpts
opts (Proxy p
forall k (t :: k). Proxy t
Proxy @p) String
msg0 [TT (n b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (n b)
qq] n b
q

_fmapImpl :: forall m n p a
  . ( P p a
    , Traversable n
    , MonadEval m
    ) => POpts
      -> Proxy p
      -> String
      -> [Tree PE]
      -> n a
      -> m (TT (n (PP p a)))
_fmapImpl :: POpts
-> Proxy p -> String -> [Tree PE] -> n a -> m (TT (n (PP p a)))
_fmapImpl POpts
opts Proxy p
proxyp String
msg0 [Tree PE]
hhs n a
na = do
        n (TT (PP p a))
nttb <- (a -> m (TT (PP p a))) -> n a -> m (n (TT (PP p a)))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((TT (PP p a) -> TT (PP p a)) -> m (TT (PP p a)) -> m (TT (PP p a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TT (PP p a)
tt -> TT (PP p a)
tt TT (PP p a) -> (TT (PP p a) -> TT (PP p a)) -> TT (PP p a)
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> TT (PP p a) -> Identity (TT (PP p a))
forall a. Lens' (TT a) String
ttString ((String -> Identity String)
 -> TT (PP p a) -> Identity (TT (PP p a)))
-> ShowS -> TT (PP p a) -> TT (PP p a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ POpts -> ShowS
litL POpts
opts
                                          TT (PP p a) -> (TT (PP p a) -> TT (PP p a)) -> TT (PP p a)
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (PP p a) -> Identity (TT (PP p a))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
 -> TT (PP p a) -> Identity (TT (PP p a)))
-> [Tree PE] -> TT (PP p a) -> TT (PP p a)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
tt]) (m (TT (PP p a)) -> m (TT (PP p a)))
-> (a -> m (TT (PP p a))) -> a -> m (TT (PP p a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval Proxy p
proxyp POpts
opts) n a
na
        let ttnb :: TT (n (PP p a))
ttnb = n (TT (PP p a)) -> TT (n (PP p a))
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA n (TT (PP p a))
nttb
        TT (n (PP p a)) -> m (TT (n (PP p a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (n (PP p a)) -> m (TT (n (PP p a))))
-> TT (n (PP p a)) -> m (TT (n (PP p a)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (n (PP p a))
-> [Tree PE]
-> Either (TT (n (PP p a))) (n (PP p a))
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
Inline POpts
opts String
"" TT (n (PP p a))
ttnb [Tree PE]
hhs of
          Left TT (n (PP p a))
e -> TT (n (PP p a))
e
          Right n (PP p a)
ret ->
            let ind :: String
ind = if n (PP p a) -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null n (PP p a)
ret then String
" <skipped>" else String
""
            in TT (n (PP p a))
ttnb TT (n (PP p a))
-> (TT (n (PP p a)) -> TT (n (PP p a))) -> TT (n (PP p a))
forall a b. a -> (a -> b) -> b
& (Val (n (PP p a)) -> Identity (Val (n (PP p a))))
-> TT (n (PP p a)) -> Identity (TT (n (PP p a)))
forall a b. Lens (TT a) (TT b) (Val a) (Val b)
ttVal ((Val (n (PP p a)) -> Identity (Val (n (PP p a))))
 -> TT (n (PP p a)) -> Identity (TT (n (PP p a))))
-> Val (n (PP p a)) -> TT (n (PP p a)) -> TT (n (PP p a))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n (PP p a) -> Val (n (PP p a))
forall a. a -> Val a
Val n (PP p a)
ret
                    TT (n (PP p a))
-> (TT (n (PP p a)) -> TT (n (PP p a))) -> TT (n (PP p a))
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (n (PP p a)) -> Identity (TT (n (PP p a)))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
 -> TT (n (PP p a)) -> Identity (TT (n (PP p a))))
-> ([Tree PE] -> [Tree PE]) -> TT (n (PP p a)) -> TT (n (PP p a))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<>)
                    TT (n (PP p a))
-> (TT (n (PP p a)) -> TT (n (PP p a))) -> TT (n (PP p a))
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> TT (n (PP p a)) -> Identity (TT (n (PP p a)))
forall a. Lens' (TT a) String
ttString ((String -> Identity String)
 -> TT (n (PP p a)) -> Identity (TT (n (PP p a))))
-> ShowS -> TT (n (PP p a)) -> TT (n (PP p a))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
ind String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
nullIf String
" "

-- | similar to 'Data.Functor.<&>'

--

-- >>> pz @('[1,2,3] <&> Succ) ()

-- Val [2,3,4]

--

data p <&> q deriving Int -> (p <&> q) -> ShowS
[p <&> q] -> ShowS
(p <&> q) -> String
(Int -> (p <&> q) -> ShowS)
-> ((p <&> q) -> String) -> ([p <&> q] -> ShowS) -> Show (p <&> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <&> q) -> ShowS
forall k (p :: k) k (q :: k). [p <&> q] -> ShowS
forall k (p :: k) k (q :: k). (p <&> q) -> String
showList :: [p <&> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <&> q] -> ShowS
show :: (p <&> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <&> q) -> String
showsPrec :: Int -> (p <&> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <&> q) -> ShowS
Show
infixl 1 <&>
type FMapFlipT p q = q <$> p

instance P (FMapFlipT p q) x => P (p <&> q) x where
  type PP (p <&> q) x = PP (FMapFlipT p q) x
  eval :: proxy (p <&> q) -> POpts -> x -> m (TT (PP (p <&> q) x))
eval proxy (p <&> q)
_ = Proxy (FMapFlipT p q)
-> POpts -> x -> m (TT (PP (FMapFlipT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FMapFlipT p q)
forall k (t :: k). Proxy t
Proxy @(FMapFlipT p q))


-- | similar to 'pure'

--

-- >>> pz @(Pure Maybe Id) 4

-- Val (Just 4)

--

-- >>> pz @(Pure [] Id) 4

-- Val [4]

--

-- >>> pz @(Pure (Either String) Fst) (13,True)

-- Val (Right 13)

--

-- >>> pl @(Pure Maybe Id) 'x'

-- Present Just 'x' (Pure Just 'x' | 'x')

-- Val (Just 'x')

--

-- >>> pl @(Pure (Either _) Id) 'x'

-- Present Right 'x' (Pure Right 'x' | 'x')

-- Val (Right 'x')

--

-- >>> pl @(Pure (Either _) Id >> Swap) 'x'

-- Present Left 'x' ((>>) Left 'x' | {Swap Left 'x' | Right 'x'})

-- Val (Left 'x')

--

-- >>> pl @(Pure (Either ()) Id >> Swap) 'x'

-- Present Left 'x' ((>>) Left 'x' | {Swap Left 'x' | Right 'x'})

-- Val (Left 'x')

--

-- >>> pl @(Pure (Either String) Id >> Swap) 123

-- Present Left 123 ((>>) Left 123 | {Swap Left 123 | Right 123})

-- Val (Left 123)

--

data Pure (t :: Type -> Type) p deriving Int -> Pure t p -> ShowS
[Pure t p] -> ShowS
Pure t p -> String
(Int -> Pure t p -> ShowS)
-> (Pure t p -> String) -> ([Pure t p] -> ShowS) -> Show (Pure t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: Type -> Type) k (p :: k). Int -> Pure t p -> ShowS
forall (t :: Type -> Type) k (p :: k). [Pure t p] -> ShowS
forall (t :: Type -> Type) k (p :: k). Pure t p -> String
showList :: [Pure t p] -> ShowS
$cshowList :: forall (t :: Type -> Type) k (p :: k). [Pure t p] -> ShowS
show :: Pure t p -> String
$cshow :: forall (t :: Type -> Type) k (p :: k). Pure t p -> String
showsPrec :: Int -> Pure t p -> ShowS
$cshowsPrec :: forall (t :: Type -> Type) k (p :: k). Int -> Pure t p -> ShowS
Show
instance ( P p x
         , Show (PP p x)
         , Show (t (PP p x))
         , Applicative t
         ) => P (Pure t p) x where
  type PP (Pure t p) x = t (PP p x)
  eval :: proxy (Pure t p) -> POpts -> x -> m (TT (PP (Pure t p) x))
eval proxy (Pure t p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"Pure"
    TT (PP p x)
pp <- Proxy p -> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x
    TT (t (PP p x)) -> m (TT (t (PP p x)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (t (PP p x)) -> m (TT (t (PP p x))))
-> TT (t (PP p x)) -> m (TT (t (PP p x)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (t (PP p x))) (PP p x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p x)
pp [] of
      Left TT (t (PP p x))
e -> TT (t (PP p x))
e
      Right PP p x
a ->
        let b :: t (PP p x)
b = PP p x -> t (PP p x)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure PP p x
a
        in POpts -> Val (t (PP p x)) -> String -> [Tree PE] -> TT (t (PP p x))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t (PP p x) -> Val (t (PP p x))
forall a. a -> Val a
Val t (PP p x)
b) (POpts -> String -> t (PP p x) -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 t (PP p x)
b PP p x
a) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]

-- | runs 'Control.Applicative.liftA2' (,) against two values: LiftA2 is traversable and provides better debugging

--

-- >>> pz @(FPair Fst Snd) (Just 10, Just True)

-- Val (Just (10,True))

--

-- >>> pz @(FPair Fst Snd >> FMap (ShowP Fst <> "---" <> ShowP Snd)) (Just 10, Just True)

-- Val (Just "10---True")

--

-- >>> pz @(FPair Fst Snd >> FMap (Fst + Snd)) (Just 10, Just 13)

-- Val (Just 23)

--

-- >>> pz @(FPair (EnumFromTo Fst Snd) ('LT ... 'GT)) (10,11)

-- Val [(10,LT),(10,EQ),(10,GT),(11,LT),(11,EQ),(11,GT)]

--

-- >>> pz @(FPair '[ '() ] (1 ... 5)) True

-- Val [((),1),((),2),((),3),((),4),((),5)]

--

data FPair p q deriving Int -> FPair p q -> ShowS
[FPair p q] -> ShowS
FPair p q -> String
(Int -> FPair p q -> ShowS)
-> (FPair p q -> String)
-> ([FPair p q] -> ShowS)
-> Show (FPair p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> FPair p q -> ShowS
forall k (p :: k) k (q :: k). [FPair p q] -> ShowS
forall k (p :: k) k (q :: k). FPair p q -> String
showList :: [FPair p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [FPair p q] -> ShowS
show :: FPair p q -> String
$cshow :: forall k (p :: k) k (q :: k). FPair p q -> String
showsPrec :: Int -> FPair p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> FPair p q -> ShowS
Show

instance ( Applicative n
         , PP p a ~ n x
         , PP q a ~ n y
         , JoinT (PP p a) (PP q a) ~ n (x,y)
         , P p a
         , P q a
         )
    => P (FPair p q) a where
  type PP (FPair p q) a = JoinT (PP p a) (PP q a)
  eval :: proxy (FPair p q) -> POpts -> a -> m (TT (PP (FPair p q) a))
eval proxy (FPair p q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"FPair"
    Either (TT (n (x, y))) (n x, n y, TT (n x), TT (n y))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (n (x, y))) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
    TT (n (x, y)) -> m (TT (n (x, y)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (n (x, y)) -> m (TT (n (x, y))))
-> TT (n (x, y)) -> m (TT (n (x, y)))
forall a b. (a -> b) -> a -> b
$ case Either (TT (n (x, y))) (n x, n y, TT (n x), TT (n y))
lr of
      Left TT (n (x, y))
e -> TT (n (x, y))
e
      Right (n x
p,n y
q,TT (n x)
pp,TT (n y)
qq) ->
        let d :: n (x, y)
d = (x -> y -> (x, y)) -> n x -> n y -> n (x, y)
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) n x
p n y
q
        in POpts -> Val (n (x, y)) -> String -> [Tree PE] -> TT (n (x, y))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (n (x, y) -> Val (n (x, y))
forall a. a -> Val a
Val n (x, y)
d) String
msg0 [TT (n x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (n x)
pp, TT (n y) -> Tree PE
forall a. TT a -> Tree PE
hh TT (n y)
qq]

-- | see 'FPair'

--

-- >>> pz @(Fst <:> Snd) (Just 10, Just True)

-- Val (Just (10,True))

--

-- >>> pz @(Fst <:> Snd) ("abc",[10,12,14])

-- Val [('a',10),('a',12),('a',14),('b',10),('b',12),('b',14),('c',10),('c',12),('c',14)]

--

-- >>> pz @('[1,2] <:> "abcdef") ()

-- Val [(1,'a'),(1,'b'),(1,'c'),(1,'d'),(1,'e'),(1,'f'),(2,'a'),(2,'b'),(2,'c'),(2,'d'),(2,'e'),(2,'f')]

--

-- >>> pz @(EnumFromTo Fst Snd <:> ('LT ... 'GT)) (10,11)

-- Val [(10,LT),(10,EQ),(10,GT),(11,LT),(11,EQ),(11,GT)]

--

-- >>> pz @(MkJust Succ <:> MkJust 4) ()   -- uses Succ on (): instead use LiftA2 with Pop0 or <*>  (see next 2 tests)

-- Fail "Succ IO e=Prelude.Enum.().succ: bad argument"

--

-- >>> pz @(LiftA2 (Pop0 Fst Snd) (MkJust (Proxy Succ)) (MkJust 4)) ()

-- Val (Just 5)

--

-- >>> pz @(MkJust Succ <*> MkJust 4) ()

-- Val (Just 5)

--

data p <:> q deriving Int -> (p <:> q) -> ShowS
[p <:> q] -> ShowS
(p <:> q) -> String
(Int -> (p <:> q) -> ShowS)
-> ((p <:> q) -> String) -> ([p <:> q] -> ShowS) -> Show (p <:> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <:> q) -> ShowS
forall k (p :: k) k (q :: k). [p <:> q] -> ShowS
forall k (p :: k) k (q :: k). (p <:> q) -> String
showList :: [p <:> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <:> q] -> ShowS
show :: (p <:> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <:> q) -> String
showsPrec :: Int -> (p <:> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <:> q) -> ShowS
Show
type FPairT p q = FPair p q
infixl 6 <:>

instance P (FPairT p q) x => P (p <:> q) x where
  type PP (p <:> q) x = PP (FPairT p q) x
  eval :: proxy (p <:> q) -> POpts -> x -> m (TT (PP (p <:> q) x))
eval proxy (p <:> q)
_ = Proxy (FPairT p q) -> POpts -> x -> m (TT (PP (FPairT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FPairT p q)
forall k (t :: k). Proxy t
Proxy @(FPairT p q))

-- | similar to monad operator 'Control.Monad.>=>'

--

-- >>> pz @(FFish Uncons (Snd >> Uncons) "abcdef") ()

-- Val (Just ('b',"cdef"))

--

-- >>> :m + Data.Time

-- >>> pz @(FFish (ReadMaybe Day Id >> FMap Fst) (MkJust Succ) "2020-02-02") ()

-- Val (Just 2020-02-03)

--

-- >>> pz @(FFish Uncons (Lookup Fst "abcdef") [3,14,12]) ()

-- Val (Just 'd')

--

data FFish amb bmc a deriving Int -> FFish amb bmc a -> ShowS
[FFish amb bmc a] -> ShowS
FFish amb bmc a -> String
(Int -> FFish amb bmc a -> ShowS)
-> (FFish amb bmc a -> String)
-> ([FFish amb bmc a] -> ShowS)
-> Show (FFish amb bmc a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (amb :: k) k (bmc :: k) k (a :: k).
Int -> FFish amb bmc a -> ShowS
forall k (amb :: k) k (bmc :: k) k (a :: k).
[FFish amb bmc a] -> ShowS
forall k (amb :: k) k (bmc :: k) k (a :: k).
FFish amb bmc a -> String
showList :: [FFish amb bmc a] -> ShowS
$cshowList :: forall k (amb :: k) k (bmc :: k) k (a :: k).
[FFish amb bmc a] -> ShowS
show :: FFish amb bmc a -> String
$cshow :: forall k (amb :: k) k (bmc :: k) k (a :: k).
FFish amb bmc a -> String
showsPrec :: Int -> FFish amb bmc a -> ShowS
$cshowsPrec :: forall k (amb :: k) k (bmc :: k) k (a :: k).
Int -> FFish amb bmc a -> ShowS
Show
type FFishT amb bmc a = a >> amb >> FMap bmc >> Join

instance P (FFishT p q r) x => P (FFish p q r) x where
  type PP (FFish p q r) x = PP (FFishT p q r) x
  eval :: proxy (FFish p q r) -> POpts -> x -> m (TT (PP (FFish p q r) x))
eval proxy (FFish p q r)
_ = Proxy (FFishT p q r) -> POpts -> x -> m (TT (PP (FFishT p q r) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FFishT p q r)
forall k (t :: k). Proxy t
Proxy @(FFishT p q r))

-- | similar to monad bind operator 'Control.Monad.>>='

--

-- >>> pz @(Id >>= HeadMay) (Just "abcdef")

-- Val (Just 'a')

--

-- >>> pz @(Uncons >>= (Snd >> HeadMay)) "abcdef"

-- Val (Just 'b')

--

-- >>> pz @((1 ... 10) >>= EmptyBool [] Even '[Id,Id]) ()

-- Val [[2,2],[4,4],[6,6],[8,8],[10,10]]

--

-- >>> pz @((1 ... 10) >>= If Even '[Id,Id] (EmptyT [] _)) ()

-- Val [2,2,4,4,6,6,8,8,10,10]

--

-- >>> pz @(Lookup 0 Id >>= Lookup 1 Id) [[1,2,3]]

-- Val (Just 2)

--

-- >>> pz @(Lookup 4 Id >>= Lookup 1 Id) [[1,2,3]]

-- Val Nothing

--

-- >>> pz @(Lookup 0 Id >>= Lookup 5 Id) [[1,2,3]]

-- Val Nothing

--

-- >>> pz @(Lookup 0 Id >>= Lookup 1 Id >>= MaybeBool Even '(Id,"is even!")) [[1,2,3]]

-- Val (Just (2,"is even!"))

--

-- >>> pz @(Lookup 0 Id >>= Lookup 1 Id >>= MaybeBool Even '(Id,"is even!")) [[1,5,3]]

-- Val Nothing

--

-- >>> pz @((48...55) >>= '[ '[ToEnum Char << Id,ToEnum Char << (Id+3),ToEnum Char << (Id+6)] ]) ()

-- Val ["036","147","258","369","47:","58;","69<","7:="]

--

-- >>> pz @((48...55) >>= '[ Map (ToEnum Char) << '[ Id, Id+3 ,Id+6 ] ]) ()

-- Val ["036","147","258","369","47:","58;","69<","7:="]

--

data ma >>= amb deriving Int -> (ma >>= amb) -> ShowS
[ma >>= amb] -> ShowS
(ma >>= amb) -> String
(Int -> (ma >>= amb) -> ShowS)
-> ((ma >>= amb) -> String)
-> ([ma >>= amb] -> ShowS)
-> Show (ma >>= amb)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (ma :: k) k (amb :: k). Int -> (ma >>= amb) -> ShowS
forall k (ma :: k) k (amb :: k). [ma >>= amb] -> ShowS
forall k (ma :: k) k (amb :: k). (ma >>= amb) -> String
showList :: [ma >>= amb] -> ShowS
$cshowList :: forall k (ma :: k) k (amb :: k). [ma >>= amb] -> ShowS
show :: (ma >>= amb) -> String
$cshow :: forall k (ma :: k) k (amb :: k). (ma >>= amb) -> String
showsPrec :: Int -> (ma >>= amb) -> ShowS
$cshowsPrec :: forall k (ma :: k) k (amb :: k). Int -> (ma >>= amb) -> ShowS
Show
type MBindT ma amb = ma >> FMap amb >> Join
infixl 1 >>=

instance P (MBindT p q) x => P (p >>= q) x where
  type PP (p >>= q) x = PP (MBindT p q) x
  eval :: proxy (p >>= q) -> POpts -> x -> m (TT (PP (p >>= q) x))
eval proxy (p >>= q)
_ = Proxy (MBindT p q) -> POpts -> x -> m (TT (PP (MBindT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (MBindT p q)
forall k (t :: k). Proxy t
Proxy @(MBindT p q))

-- | applicative bind similar to 'Control.Applicative.<*>' but functions have to be fully saturated: ie Len is ok but not Length

--   can use Proxy to delay evaluation until Pop0

--

-- >>> pz @(MkJust '("sdf",Id) <*> MkJust 4) ()

-- Val (Just ("sdf",4))

--

-- >>> pz @(MkJust Succ <*> MkJust 4) ()

-- Val (Just 5)

--

-- >>> pz @('[Succ,Id,Pred] <*> "abcdef") undefined

-- Val "ba`cbadcbedcfedgfe"

--

-- >>> pz @(MkJust "abc" <*> MkJust "def") () -- no function to apply so has to choose ie first one

-- Val (Just "abc")

--

-- >>> pz @('[1,2] <*> "abcdef") () -- [1,2] <* "abcdef" -- ie skips rhs "abcdef" but still runs the effects

-- Val [1,2,1,2,1,2,1,2,1,2,1,2]

--

-- >>> pz @(MkJust ((*) 3 Id) <*> MkJust 4) ()

-- Val (Just 12)

--

-- >>> pz @(MkJust ((*) 3 Len) <*> MkJust '["aa","bb","c","d","e"]) ()

-- Val (Just 15)

--

-- >>> pz @(ShowP Id <$> MkJust Succ <*> MkJust 4) ()

-- Val (Just "5")

--

-- >>> pz @('["x","y"] <*> '[1,2,3]) ()

-- Val ["x","y","x","y","x","y"]

--

data p <*> q deriving Int -> (p <*> q) -> ShowS
[p <*> q] -> ShowS
(p <*> q) -> String
(Int -> (p <*> q) -> ShowS)
-> ((p <*> q) -> String) -> ([p <*> q] -> ShowS) -> Show (p <*> q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> (p <*> q) -> ShowS
forall k (p :: k) k (q :: k). [p <*> q] -> ShowS
forall k (p :: k) k (q :: k). (p <*> q) -> String
showList :: [p <*> q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [p <*> q] -> ShowS
show :: (p <*> q) -> String
$cshow :: forall k (p :: k) k (q :: k). (p <*> q) -> String
showsPrec :: Int -> (p <*> q) -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> (p <*> q) -> ShowS
Show
--type AppT fab fa = fab >>= (Id <$> fa) -- need some way to flip function application

-- expecting (a -> b) -> f a -> f b

-- but we want a -> (f (a -> b)) -> f b

infixl 1 <*>

type AppT fab fa = fa >>= (Id <$> fab) -- this works surprisingly well but args are flipped


instance P (AppT p q) x => P (p <*> q) x where
  type PP (p <*> q) x = PP (AppT p q) x
  eval :: proxy (p <*> q) -> POpts -> x -> m (TT (PP (p <*> q) x))
eval proxy (p <*> q)
_ = Proxy (AppT p q) -> POpts -> x -> m (TT (PP (AppT p q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (AppT p q)
forall k (t :: k). Proxy t
Proxy @(AppT p q))

-- | similar to 'flip':see also 'Predicate.Misc.FlipT'

--

-- >>> pz @(Flip Map' Id Succ) [1..5]

-- Val [2,3,4,5,6]

--

-- >>> pz @(Flip '(,) 'True 2) ()

-- Val (2,True)

--

-- >>> pz @(Flip ('(,,) 1) 2 Id) "ab"

-- Val (1,"ab",2)

--

data Flip (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1) deriving Int -> Flip p q r -> ShowS
[Flip p q r] -> ShowS
Flip p q r -> String
(Int -> Flip p q r -> ShowS)
-> (Flip p q r -> String)
-> ([Flip p q r] -> ShowS)
-> Show (Flip p q r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k3 k2 k1 (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1).
Int -> Flip p q r -> ShowS
forall k3 k2 k1 (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1).
[Flip p q r] -> ShowS
forall k3 k2 k1 (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1).
Flip p q r -> String
showList :: [Flip p q r] -> ShowS
$cshowList :: forall k3 k2 k1 (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1).
[Flip p q r] -> ShowS
show :: Flip p q r -> String
$cshow :: forall k3 k2 k1 (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1).
Flip p q r -> String
showsPrec :: Int -> Flip p q r -> ShowS
$cshowsPrec :: forall k3 k2 k1 (p :: k1 -> k2 -> k3) (q :: k2) (r :: k1).
Int -> Flip p q r -> ShowS
Show
-- needs explicit types


instance P (p r q) x => P (Flip p q r) x where
  type PP (Flip p q r) x = PP (p r q) x
  eval :: proxy (Flip p q r) -> POpts -> x -> m (TT (PP (Flip p q r) x))
eval proxy (Flip p q r)
_ = Proxy (p r q) -> POpts -> x -> m (TT (PP (p r q) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (p r q)
forall k (t :: k). Proxy t
Proxy @(p r q))


-- | similar to 'Control.Applicative.liftA2'

--

-- >>> pan @(LiftA2 Id (MkJust 12) (MkJust "abc")) ()

-- P LiftA2 Id (12,"abc")

-- |

-- +- P MkJust Just 12

-- |  |

-- |  `- P '12

-- |

-- +- P MkJust Just "abc"

-- |  |

-- |  `- P '"abc"

-- |

-- `- P Id (12,"abc")

-- Val (Just (12,"abc"))

--

-- >>> pan @(LiftA2 Swap (MkJust 12) (MkNothing _)) ()

-- P LiftA2 <skipped>

-- |

-- +- P MkJust Just 12

-- |  |

-- |  `- P '12

-- |

-- `- P MkNothing

-- Val Nothing

--

-- >>> pz @(LiftA2 (ShowP Fst <> "---" <> ShowP Snd) Fst Snd) (Just 10, Just True)

-- Val (Just "10---True")

--

-- >>> pz @(LiftA2 (Fst + Snd) Fst Snd) (Just 10, Just 13)

-- Val (Just 23)

--

-- >>> pz @(LiftA2 Fst '["x","y"] '[1,2,3]) ()

-- Val ["x","x","x","y","y","y"]

--

-- >>> pz @(LiftA2 Snd '["x","y"] '[1,2,3]) ()

-- Val [1,2,3,1,2,3]

--

-- >>> pz @(LiftA2 (Pop0 Fst Snd) '[ Proxy Len ] '[ "abc", "def", "aaaaaaaaaaa"]) ()

-- Val [3,3,11]

--

-- >>> pz @(LiftA2 (Fst * Snd) (FromList (ZipList _) << (10...15)) (FromList (ZipList _) << (1...10))) ()

-- Val (ZipList {getZipList = [10,22,36,52,70,90]})

--

data LiftA2 p q r deriving Int -> LiftA2 p q r -> ShowS
[LiftA2 p q r] -> ShowS
LiftA2 p q r -> String
(Int -> LiftA2 p q r -> ShowS)
-> (LiftA2 p q r -> String)
-> ([LiftA2 p q r] -> ShowS)
-> Show (LiftA2 p q r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k) k (r :: k).
Int -> LiftA2 p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). [LiftA2 p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). LiftA2 p q r -> String
showList :: [LiftA2 p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k). [LiftA2 p q r] -> ShowS
show :: LiftA2 p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k). LiftA2 p q r -> String
showsPrec :: Int -> LiftA2 p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k).
Int -> LiftA2 p q r -> ShowS
Show
-- i provide the rhs as the environment to fa and fb? so fails Succ

-- use <*> as it works way better

-- use Proxy to delay setting the environment and then use Pop1 to run against a specific environment


instance ( Traversable n
         , Applicative n
         , P p (a,b)
         , P q x
         , P r x
         , PP p (a,b) ~ c
         , PP q x ~ n a
         , PP r x ~ n b
         ) => P (LiftA2 p q r) x where
  type PP (LiftA2 p q r) x = (ExtractTFromTA (PP q x)) (PP p (ExtractAFromTA (PP q x), ExtractAFromTA (PP r x)))
  eval :: proxy (LiftA2 p q r) -> POpts -> x -> m (TT (PP (LiftA2 p q r) x))
eval proxy (LiftA2 p q r)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"LiftA2"
    Either (TT (n c)) (n a, n b, TT (n a), TT (n b))
lr <- Inline
-> String
-> Proxy q
-> Proxy r
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT (n c)) (PP q x, PP r x, TT (PP q x), TT (PP r x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy q
forall k (t :: k). Proxy t
Proxy @q) (Proxy r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts x
x []
    case Either (TT (n c)) (n a, n b, TT (n a), TT (n b))
lr of
      Left TT (n c)
e -> TT (n c) -> m (TT (n c))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (n c)
e
      Right (n a
q,n b
r,TT (n a)
qq,TT (n b)
rr) -> do
        let w :: n (a, b)
w = (a -> b -> (a, b)) -> n a -> n b -> n (a, b)
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) n a
q n b
r
        POpts
-> Proxy p
-> String
-> [Tree PE]
-> n (a, b)
-> m (TT (n (PP p (a, b))))
forall k (m :: Type -> Type) (n :: Type -> Type) (p :: k) a.
(P p a, Traversable n, MonadEval m) =>
POpts
-> Proxy p -> String -> [Tree PE] -> n a -> m (TT (n (PP p a)))
_fmapImpl POpts
opts (Proxy p
forall k (t :: k). Proxy t
Proxy @p) String
msg0 [TT (n a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (n a)
qq, TT (n b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (n b)
rr] n (a, b)
w

-- | similar to 'Data.Bifunctor.bimap'

--

-- >>> pz @(BiMap Succ Head) (Left @_ @String 12) -- needs a type signature for Right

-- Val (Left 13)

--

-- >>> pz @(BiMap Succ Head) (Right "xyz")

-- Val (Right 'x')

--

-- >>> pz @(FMap (BiMap Succ Head)) [Right "xyz",Left 'a',Right "ab",Left 'x']

-- Val [Right 'x',Left 'b',Right 'a',Left 'y']

--

-- >>> pz @(FMap (BiMap Succ Pred)) [These 12 'b', This 1, That 'd',That 'e']

-- Val [These 13 'a',This 2,That 'c',That 'd']

--

-- >>> pz @(BiMap Succ Pred) (True,12,'b')

-- Val (True,13,'a')

--

-- >>> pl @(FMap $ BiMap Succ (Not Id)) [This @Int @Bool 1, This 2,That True,These 4 False]

-- Present [This 2,This 3,That False,These 5 True] (FMap BiMap(L) Succ 2 | 1 | BiMap(L) Succ 3 | 2 | BiMap(R) Not (Id True) | BiMap(B) Succ 5 | 4 | Not (Id False))

-- Val [This 2,This 3,That False,These 5 True]

--

-- >>> pl @(BiMap Succ (Not Id)) (This @Int @Bool 1)

-- Present This 2 (BiMap(L) Succ 2 | 1)

-- Val (This 2)

--

-- >>> pl @(BiMap Succ (Not Id)) (That @Int @Bool True)

-- Present That False (BiMap(R) Not (Id True))

-- Val (That False)

--

-- >>> pl @(BiMap Succ (Not Id)) (These @Int @Bool 1 True)

-- Present These 2 False (BiMap(B) Succ 2 | 1 | Not (Id True))

-- Val (These 2 False)

--

-- >>> pan @(FMap $ BiMap Succ (Not Id)) [This @Int @Bool 1, This 2,That True,These 4 False]

-- P FMap BiMap(L) Succ 2 | BiMap(L) Succ 3 | BiMap(R) Not | BiMap(B) Succ 5 | Not

-- |

-- +- P BiMap(L) Succ 2

-- |  |

-- |  `- P Succ 2

-- |

-- +- P BiMap(L) Succ 3

-- |  |

-- |  `- P Succ 3

-- |

-- +- P BiMap(R) Not

-- |  |

-- |  `- False Not

-- |     |

-- |     `- True Id True

-- |

-- `- P BiMap(B) Succ 5 | Not

--    |

--    +- P Succ 5

--    |

--    `- True Not

--       |

--       `- False Id False

-- Val [This 2,This 3,That False,These 5 True]

--

-- >>> pl @(BiMap Succ Head) (ENone @Int @String)

-- Present ENone (BiMap <skipped>)

-- Val ENone

--

-- >>> pl @(BiMap Succ Head) (ELeft @Int @String 10)

-- Present ELeft 11 (BiMap(L) Succ 11 | 10)

-- Val (ELeft 11)

--

-- >>> pl @(BiMap Succ Head) (ERight @Int @String "xyz")

-- Present ERight 'x' (BiMap(R) Head 'x' | "xyz")

-- Val (ERight 'x')

--

-- >>> pl @(BiMap Succ Head) (EBoth @Int @String 10 "xyz")

-- Present EBoth 11 'x' (BiMap(B) Succ 11 | 10 | Head 'x' | "xyz")

-- Val (EBoth 11 'x')

--

-- >>> pan @(FMap $ BiMap Succ Head) [ENone,ELeft 10,ERight "abc",EBoth 10 "xyz"]

-- P FMap BiMap <skipped> | BiMap(L) Succ 11 | BiMap(R) Head 'a' | BiMap(B) Succ 11 | Head 'x'

-- |

-- +- P BiMap <skipped>

-- |

-- +- P BiMap(L) Succ 11

-- |  |

-- |  `- P Succ 11

-- |

-- +- P BiMap(R) Head 'a'

-- |  |

-- |  `- P Head 'a'

-- |

-- `- P BiMap(B) Succ 11 | Head 'x'

--    |

--    +- P Succ 11

--    |

--    `- P Head 'x'

-- Val [ENone,ELeft 11,ERight 'a',EBoth 11 'x']

--

data BiMap p q deriving Int -> BiMap p q -> ShowS
[BiMap p q] -> ShowS
BiMap p q -> String
(Int -> BiMap p q -> ShowS)
-> (BiMap p q -> String)
-> ([BiMap p q] -> ShowS)
-> Show (BiMap p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> BiMap p q -> ShowS
forall k (p :: k) k (q :: k). [BiMap p q] -> ShowS
forall k (p :: k) k (q :: k). BiMap p q -> String
showList :: [BiMap p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [BiMap p q] -> ShowS
show :: BiMap p q -> String
$cshow :: forall k (p :: k) k (q :: k). BiMap p q -> String
showsPrec :: Int -> BiMap p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> BiMap p q -> ShowS
Show

instance ( Bitraversable n
         , P p a
         , P q b
         ) => P (BiMap p q) (n a b) where
  type PP (BiMap p q) (n a b) = n (PP p a) (PP q b)
  eval :: proxy (BiMap p q)
-> POpts -> n a b -> m (TT (PP (BiMap p q) (n a b)))
eval proxy (BiMap p q)
_ POpts
opts n a b
nab = do
    let msg0 :: String
msg0 = String
"BiMap"
    POpts
-> Proxy p
-> Proxy q
-> String
-> [Tree PE]
-> n a b
-> m (TT (n (PP p a) (PP q b)))
forall k k (m :: Type -> Type) (n :: Type -> Type -> Type) (p :: k)
       (q :: k) a b.
(P p a, P q b, Bitraversable n, MonadEval m) =>
POpts
-> Proxy p
-> Proxy q
-> String
-> [Tree PE]
-> n a b
-> m (TT (n (PP p a) (PP q b)))
_bimapImpl POpts
opts (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) String
msg0 [] n a b
nab

_bimapImpl :: forall m n p q a b
  . ( P p a
    , P q b
    , Bitraversable n
    , MonadEval m
    ) => POpts
      -> Proxy p
      -> Proxy q
      -> String
      -> [Tree PE]
      -> n a b
      -> m (TT (n (PP p a) (PP q b)))
_bimapImpl :: POpts
-> Proxy p
-> Proxy q
-> String
-> [Tree PE]
-> n a b
-> m (TT (n (PP p a) (PP q b)))
_bimapImpl POpts
opts Proxy p
proxyp Proxy q
proxyq String
msg0 [Tree PE]
hhs n a b
nab = do
  n (TT (PP p a)) (TT (PP q b))
nttb <- (a -> m (TT (PP p a)))
-> (b -> m (TT (PP q b)))
-> n a b
-> m (n (TT (PP p a)) (TT (PP q b)))
forall (t :: Type -> Type -> Type) (f :: Type -> Type) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse
            ((TT (PP p a) -> TT (PP p a)) -> m (TT (PP p a)) -> m (TT (PP p a))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TT (PP p a)
tt -> TT (PP p a)
tt TT (PP p a) -> (TT (PP p a) -> TT (PP p a)) -> TT (PP p a)
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> TT (PP p a) -> Identity (TT (PP p a))
forall a. Lens' (TT a) String
ttString ((String -> Identity String)
 -> TT (PP p a) -> Identity (TT (PP p a)))
-> ShowS -> TT (PP p a) -> TT (PP p a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ POpts -> ShowS
litL POpts
opts
                             TT (PP p a) -> (TT (PP p a) -> TT (PP p a)) -> TT (PP p a)
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (PP p a) -> Identity (TT (PP p a))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
 -> TT (PP p a) -> Identity (TT (PP p a)))
-> [Tree PE] -> TT (PP p a) -> TT (PP p a)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
tt]) (m (TT (PP p a)) -> m (TT (PP p a)))
-> (a -> m (TT (PP p a))) -> a -> m (TT (PP p a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval Proxy p
proxyp POpts
opts)
            ((TT (PP q b) -> TT (PP q b)) -> m (TT (PP q b)) -> m (TT (PP q b))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TT (PP q b)
tt -> TT (PP q b)
tt TT (PP q b) -> (TT (PP q b) -> TT (PP q b)) -> TT (PP q b)
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> TT (PP q b) -> Identity (TT (PP q b))
forall a. Lens' (TT a) String
ttString ((String -> Identity String)
 -> TT (PP q b) -> Identity (TT (PP q b)))
-> ShowS -> TT (PP q b) -> TT (PP q b)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ POpts -> ShowS
litL POpts
opts
                             TT (PP q b) -> (TT (PP q b) -> TT (PP q b)) -> TT (PP q b)
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (PP q b) -> Identity (TT (PP q b))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
 -> TT (PP q b) -> Identity (TT (PP q b)))
-> [Tree PE] -> TT (PP q b) -> TT (PP q b)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TT (PP q b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q b)
tt]) (m (TT (PP q b)) -> m (TT (PP q b)))
-> (b -> m (TT (PP q b))) -> b -> m (TT (PP q b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy q -> POpts -> b -> m (TT (PP q b))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval Proxy q
proxyq POpts
opts)
            n a b
nab
  let ttnb :: TT (n (PP p a) (PP q b))
ttnb = n (TT (PP p a)) (TT (PP q b)) -> TT (n (PP p a) (PP q b))
forall (t :: Type -> Type -> Type) (f :: Type -> Type) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence n (TT (PP p a)) (TT (PP q b))
nttb
  TT (n (PP p a) (PP q b)) -> m (TT (n (PP p a) (PP q b)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (n (PP p a) (PP q b)) -> m (TT (n (PP p a) (PP q b))))
-> TT (n (PP p a) (PP q b)) -> m (TT (n (PP p a) (PP q b)))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (n (PP p a) (PP q b))
-> [Tree PE]
-> Either (TT (n (PP p a) (PP q b))) (n (PP p a) (PP q b))
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
Inline POpts
opts String
"" TT (n (PP p a) (PP q b))
ttnb [Tree PE]
hhs of
    Left TT (n (PP p a) (PP q b))
e -> TT (n (PP p a) (PP q b))
e
    Right n (PP p a) (PP q b)
ret ->
      let ind :: String
ind = n (PP p a) (PP q b) -> String
forall (bi :: Type -> Type -> Type) a b.
Bifoldable bi =>
bi a b -> String
getBifoldInfo n (PP p a) (PP q b)
ret
      in TT (n (PP p a) (PP q b))
ttnb TT (n (PP p a) (PP q b))
-> (TT (n (PP p a) (PP q b)) -> TT (n (PP p a) (PP q b)))
-> TT (n (PP p a) (PP q b))
forall a b. a -> (a -> b) -> b
& (Val (n (PP p a) (PP q b)) -> Identity (Val (n (PP p a) (PP q b))))
-> TT (n (PP p a) (PP q b)) -> Identity (TT (n (PP p a) (PP q b)))
forall a b. Lens (TT a) (TT b) (Val a) (Val b)
ttVal ((Val (n (PP p a) (PP q b))
  -> Identity (Val (n (PP p a) (PP q b))))
 -> TT (n (PP p a) (PP q b)) -> Identity (TT (n (PP p a) (PP q b))))
-> Val (n (PP p a) (PP q b))
-> TT (n (PP p a) (PP q b))
-> TT (n (PP p a) (PP q b))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ n (PP p a) (PP q b) -> Val (n (PP p a) (PP q b))
forall a. a -> Val a
Val n (PP p a) (PP q b)
ret
              TT (n (PP p a) (PP q b))
-> (TT (n (PP p a) (PP q b)) -> TT (n (PP p a) (PP q b)))
-> TT (n (PP p a) (PP q b))
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (n (PP p a) (PP q b)) -> Identity (TT (n (PP p a) (PP q b)))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
 -> TT (n (PP p a) (PP q b)) -> Identity (TT (n (PP p a) (PP q b))))
-> ([Tree PE] -> [Tree PE])
-> TT (n (PP p a) (PP q b))
-> TT (n (PP p a) (PP q b))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<>)
              TT (n (PP p a) (PP q b))
-> (TT (n (PP p a) (PP q b)) -> TT (n (PP p a) (PP q b)))
-> TT (n (PP p a) (PP q b))
forall a b. a -> (a -> b) -> b
& (String -> Identity String)
-> TT (n (PP p a) (PP q b)) -> Identity (TT (n (PP p a) (PP q b)))
forall a. Lens' (TT a) String
ttString ((String -> Identity String)
 -> TT (n (PP p a) (PP q b)) -> Identity (TT (n (PP p a) (PP q b))))
-> ShowS -> TT (n (PP p a) (PP q b)) -> TT (n (PP p a) (PP q b))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
ind String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
nullIf String
" "

-- | a version of 'Data.Bifoldable.bifoldMap'

--

-- >>> pl @(BiFoldMap Id Id) (Right [10..13])

-- Present [10,11,12,13] (BiFoldMap(R) Id [10,11,12,13])

-- Val [10,11,12,13]

--

-- >>> pl @(BiFoldMap Id Id) (Left [10..13])

-- Present [10,11,12,13] (BiFoldMap(L) Id [10,11,12,13])

-- Val [10,11,12,13]

--

-- >>> pl @(BiFoldMap Id Id) (SG.Arg [1..5] [10..13])

-- Present [1,2,3,4,5,10,11,12,13] (BiFoldMap(B) Id [1,2,3,4,5] | Id [10,11,12,13])

-- Val [1,2,3,4,5,10,11,12,13]

--

-- >>> pz @(BiFoldMap (Wrap (SG.Sum _) Id) (Wrap (SG.Sum _) Id)) (SG.Arg 1 4)

-- Val (Sum {getSum = 5})

--

-- >>> pl @(BiFoldMap '( '[Id], '[]) '( '[], '[Id])) (SG.Arg "hap" "bcd")

-- Present (["hap"],["bcd"]) (BiFoldMap(B) '(["hap"],[]) | '([],["bcd"]))

-- Val (["hap"],["bcd"])

--

-- >>> pz @(BiFoldMap '(Wrap (SG.Sum _) Id, MEmptyT _) '(MEmptyT _, Id)) (SG.Arg 123 "xyz")

-- Val (Sum {getSum = 123},"xyz")

--

-- >>> pl @(BiFoldMap '(Wrap (SG.Sum _) Id, MEmptyT _) '(MEmptyT _, Id)) (Left 123)

-- Present (Sum {getSum = 123},()) (BiFoldMap(L) '(Sum {getSum = 123},()))

-- Val (Sum {getSum = 123},())

--

-- >>> pz @(BiFoldMap (MEmptyT _) $ FoldMap (FoldMap (Wrap (SG.Sum _) Id))) (Right (Just [1..10]))

-- Val (Sum {getSum = 55})

--

data BiFoldMap p q deriving Int -> BiFoldMap p q -> ShowS
[BiFoldMap p q] -> ShowS
BiFoldMap p q -> String
(Int -> BiFoldMap p q -> ShowS)
-> (BiFoldMap p q -> String)
-> ([BiFoldMap p q] -> ShowS)
-> Show (BiFoldMap p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> BiFoldMap p q -> ShowS
forall k (p :: k) k (q :: k). [BiFoldMap p q] -> ShowS
forall k (p :: k) k (q :: k). BiFoldMap p q -> String
showList :: [BiFoldMap p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [BiFoldMap p q] -> ShowS
show :: BiFoldMap p q -> String
$cshow :: forall k (p :: k) k (q :: k). BiFoldMap p q -> String
showsPrec :: Int -> BiFoldMap p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> BiFoldMap p q -> ShowS
Show

instance ( Bitraversable n
         , Monoid t
         , PP p a ~ t
         , PP q b ~ t
         , P p a
         , P q b
         ) => P (BiFoldMap p q) (n a b) where
  type PP (BiFoldMap p q) (n a b) = PP p a
  eval :: proxy (BiFoldMap p q)
-> POpts -> n a b -> m (TT (PP (BiFoldMap p q) (n a b)))
eval proxy (BiFoldMap p q)
_ POpts
opts n a b
nab = do
    let msg0 :: String
msg0 = String
"BiFoldMap"
    n (TT t) (TT t)
nttb <- (a -> m (TT t)) -> (b -> m (TT t)) -> n a b -> m (n (TT t) (TT t))
forall (t :: Type -> Type -> Type) (f :: Type -> Type) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse
              ((TT t -> TT t) -> m (TT t) -> m (TT t)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TT t
tt -> TT t
tt TT t -> (TT t -> TT t) -> TT t
forall a b. a -> (a -> b) -> b
& (String -> Identity String) -> TT t -> Identity (TT t)
forall a. Lens' (TT a) String
ttString ((String -> Identity String) -> TT t -> Identity (TT t))
-> ShowS -> TT t -> TT t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ POpts -> ShowS
litL POpts
opts
                               TT t -> (TT t -> TT t) -> TT t
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE]) -> TT t -> Identity (TT t)
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE]) -> TT t -> Identity (TT t))
-> [Tree PE] -> TT t -> TT t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TT t -> Tree PE
forall a. TT a -> Tree PE
hh TT t
tt]) (m (TT t) -> m (TT t)) -> (a -> m (TT t)) -> a -> m (TT t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts)
              ((TT t -> TT t) -> m (TT t) -> m (TT t)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TT t
tt -> TT t
tt TT t -> (TT t -> TT t) -> TT t
forall a b. a -> (a -> b) -> b
& (String -> Identity String) -> TT t -> Identity (TT t)
forall a. Lens' (TT a) String
ttString ((String -> Identity String) -> TT t -> Identity (TT t))
-> ShowS -> TT t -> TT t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ POpts -> ShowS
litL POpts
opts
                               TT t -> (TT t -> TT t) -> TT t
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE]) -> TT t -> Identity (TT t)
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE]) -> TT t -> Identity (TT t))
-> [Tree PE] -> TT t -> TT t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TT t -> Tree PE
forall a. TT a -> Tree PE
hh TT t
tt]) (m (TT t) -> m (TT t)) -> (b -> m (TT t)) -> b -> m (TT t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy q -> POpts -> b -> m (TT (PP q b))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts)
              n a b
nab
    let ttnb :: TT (n t t)
ttnb = n (TT t) (TT t) -> TT (n t t)
forall (t :: Type -> Type -> Type) (f :: Type -> Type) a b.
(Bitraversable t, Applicative f) =>
t (f a) (f b) -> f (t a b)
bisequence n (TT t) (TT t)
nttb
    TT t -> m (TT t)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT t -> m (TT t)) -> TT t -> m (TT t)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (n t t)
-> [Tree PE]
-> Either (TT t) (n t t)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
Inline POpts
opts String
"" TT (n t t)
ttnb [] of
      Left TT t
e -> TT t
e
      Right n t t
ret ->
        let d :: t
d = (t -> t) -> (t -> t) -> n t t -> t
forall (p :: Type -> Type -> Type) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap t -> t
forall a. a -> a
id t -> t
forall a. a -> a
id n t t
ret
            ind :: String
ind = n t t -> String
forall (bi :: Type -> Type -> Type) a b.
Bifoldable bi =>
bi a b -> String
getBifoldInfo n t t
ret
        in TT (n t t)
ttnb TT (n t t) -> (TT (n t t) -> TT t) -> TT t
forall a b. a -> (a -> b) -> b
& (Val (n t t) -> Identity (Val t)) -> TT (n t t) -> Identity (TT t)
forall a b. Lens (TT a) (TT b) (Val a) (Val b)
ttVal ((Val (n t t) -> Identity (Val t))
 -> TT (n t t) -> Identity (TT t))
-> Val t -> TT (n t t) -> TT t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ t -> Val t
forall a. a -> Val a
Val t
d
                TT t -> (TT t -> TT t) -> TT t
forall a b. a -> (a -> b) -> b
& (String -> Identity String) -> TT t -> Identity (TT t)
forall a. Lens' (TT a) String
ttString ((String -> Identity String) -> TT t -> Identity (TT t))
-> ShowS -> TT t -> TT t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
ind String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
nullIf String
" "

-- | similar to 'Data.Coerce.coerce'

--

-- >>> pz @(Coerce (SG.Sum Integer)) (Identity (-13))

-- Val (Sum {getSum = -13})

--

-- >>> pl @(Coerce SG.Any) True

-- Present Any {getAny = True} (Coerce Any {getAny = True} | True)

-- Val (Any {getAny = True})

--

-- >>> pl @(Coerce Bool) (SG.Any True)

-- Present True (Coerce True | Any {getAny = True})

-- Val True

--

-- >>> pz @(Proxy 'True >> Coerce (Proxy 'False)) () ^!? acts . _Val . to typeRep

-- Just 'False

--

-- >>> pz @(Proxy Int >> Coerce (Proxy (String,Char))) () ^!? acts . _Val . to typeRep

-- Just ([Char],Char)

--

-- >>> import qualified GHC.Exts as GE

-- >>> pz @(Proxy GE.Any >> Coerce (Proxy Int)) () ^!? acts . _Val . to typeRep

-- Just Int

--

-- >>> pz @(Proxy '(_,_) >> Coerce (Proxy '(Float,Int))) () ^!? acts . _Val . to typeRep

-- Just ('(,) * * Float Int)

--

data Coerce (t :: Type) deriving Int -> Coerce t -> ShowS
[Coerce t] -> ShowS
Coerce t -> String
(Int -> Coerce t -> ShowS)
-> (Coerce t -> String) -> ([Coerce t] -> ShowS) -> Show (Coerce t)
forall t. Int -> Coerce t -> ShowS
forall t. [Coerce t] -> ShowS
forall t. Coerce t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Coerce t] -> ShowS
$cshowList :: forall t. [Coerce t] -> ShowS
show :: Coerce t -> String
$cshow :: forall t. Coerce t -> String
showsPrec :: Int -> Coerce t -> ShowS
$cshowsPrec :: forall t. Int -> Coerce t -> ShowS
Show

instance ( Coercible t a
         , Show a
         , Show t
         ) => P (Coerce t) a where
  type PP (Coerce t) a = t
  eval :: proxy (Coerce t) -> POpts -> a -> m (TT (PP (Coerce t) a))
eval proxy (Coerce t)
_ POpts
opts a
a =
    let msg0 :: String
msg0 = String
"Coerce"
        d :: t
d = a
a a -> Getting t a t -> t
forall s a. s -> Getting a s a -> a
^. Getting t a t
forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
coerced
    in TT t -> m (TT t)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT t -> m (TT t)) -> TT t -> m (TT t)
forall a b. (a -> b) -> a -> b
$ POpts -> Val t -> String -> [Tree PE] -> TT t
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (t -> Val t
forall a. a -> Val a
Val t
d) (POpts -> String -> t -> a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 t
d a
a) []