{-# 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 #-}
-- | promoted tuple functions

module Predicate.Data.Tuple (

 -- ** arrows

    Dup
  , First
  , Second
  , type (&&&)
  , type (***)
  , Both
  , On
  , On'
  , Uncurry

 -- ** flat tuples

  , Tuple
  , Tuple'
  , Pairs

 -- ** boolean

  , AndA
  , type (&*)
  , OrA
  , type (|+)

 -- ** inductive tuples

  , EachITuple
  , ToITuple
  , FromITuple
  , ReverseITuple
  , ToITupleList

 -- ** assoc

  , Assoc
  , Unassoc
 ) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Data.Proxy (Proxy(Proxy))
import GHC.TypeNats (Nat, KnownNat)
import qualified GHC.TypeLits as GL
import Control.Lens
import Data.Kind (Type)

-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XOverloadedStrings

-- >>> :set -XNoOverloadedLists

-- >>> import Predicate

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

-- >>> :m + Data.These

-- >>> :m + Data.Ratio


-- | duplicate a value into a tuple

--

-- >>> pl @Dup 4

-- Present (4,4) ('(4,4))

-- Val (4,4)

--

-- >>> pl @(Dup >> Id) 4

-- Present (4,4) ((>>) (4,4) | {Id (4,4)})

-- Val (4,4)

--

-- >>> pl @(Dup << Fst * Snd) (4,5)

-- Present (20,20) ((>>) (20,20) | {'(20,20)})

-- Val (20,20)

--

-- >>> pl @(Fst * Snd >> Dup) (4,5)

-- Present (20,20) ((>>) (20,20) | {'(20,20)})

-- Val (20,20)

--

data Dup deriving Int -> Dup -> ShowS
[Dup] -> ShowS
Dup -> String
(Int -> Dup -> ShowS)
-> (Dup -> String) -> ([Dup] -> ShowS) -> Show Dup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Dup] -> ShowS
$cshowList :: [Dup] -> ShowS
show :: Dup -> String
$cshow :: Dup -> String
showsPrec :: Int -> Dup -> ShowS
$cshowsPrec :: Int -> Dup -> ShowS
Show
type DupT = W '(Id, Id)

instance Show x => P Dup x where
  type PP Dup x = PP DupT x
  eval :: proxy Dup -> POpts -> x -> m (TT (PP Dup x))
eval proxy Dup
_ = Proxy DupT -> POpts -> x -> m (TT (PP DupT 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 DupT
forall k (t :: k). Proxy t
Proxy @DupT)

-- | creates a list of overlapping pairs of elements. requires two or more elements

--

-- >>> pz @Pairs [1,2,3,4]

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

--

-- >>> pz @Pairs []

-- Val []

--

-- >>> pz @Pairs [1]

-- Val []

--

-- >>> pl @Pairs [1,2]

-- Present [(1,2)] (Pairs [(1,2)] | [1,2])

-- Val [(1,2)]

--

-- >>> pl @Pairs [1,2,3]

-- Present [(1,2),(2,3)] (Pairs [(1,2),(2,3)] | [1,2,3])

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

--

-- >>> pl @Pairs [1,2,3,4]

-- Present [(1,2),(2,3),(3,4)] (Pairs [(1,2),(2,3),(3,4)] | [1,2,3,4])

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

--

-- >>> pan @(Pairs >> Len >> 'True >> 'False >> FailT _ "xyzzy") "abcde"

-- [Error xyzzy] False

-- |

-- +- P Pairs [('a','b'),('b','c'),('c','d'),('d','e')]

-- |

-- +- P Len 4

-- |

-- +- True 'True

-- |

-- +- False 'False

-- |

-- `- [Error xyzzy]

-- Fail "xyzzy"

--

data Pairs deriving Int -> Pairs -> ShowS
[Pairs] -> ShowS
Pairs -> String
(Int -> Pairs -> ShowS)
-> (Pairs -> String) -> ([Pairs] -> ShowS) -> Show Pairs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pairs] -> ShowS
$cshowList :: [Pairs] -> ShowS
show :: Pairs -> String
$cshow :: Pairs -> String
showsPrec :: Int -> Pairs -> ShowS
$cshowsPrec :: Int -> Pairs -> ShowS
Show
instance ([a] ~ x, Show a) => P Pairs x where
  type PP Pairs x = [(ExtractAFromTA x,ExtractAFromTA x)]
  eval :: proxy Pairs -> POpts -> x -> m (TT (PP Pairs x))
eval proxy Pairs
_ POpts
opts x
as =
    let zs :: [(a, a)]
zs = case x
as of
               [] -> []
               _:bs -> [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip x
[a]
as [a]
bs
    in TT [(a, a)] -> m (TT [(a, a)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(a, a)] -> m (TT [(a, a)])) -> TT [(a, a)] -> m (TT [(a, a)])
forall a b. (a -> b) -> a -> b
$ POpts -> Val [(a, a)] -> String -> [Tree PE] -> TT [(a, a)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(a, a)] -> Val [(a, a)]
forall a. a -> Val a
Val [(a, a)]
zs) (POpts -> String -> [(a, a)] -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
"Pairs" [(a, a)]
zs x
as) []

-- | similar to 'Control.Arrow.&&&'

--

-- >>> pl @(Min &&& Max >> Id >> Fst < Snd) [10,4,2,12,14]

-- True ((>>) True | {2 < 14})

-- Val True

--

-- >>> pl @((123 &&& Id) >> Fst + Snd) 4

-- Present 127 ((>>) 127 | {123 + 4 = 127})

-- Val 127

--

-- >>> pl @(4 &&& "sadf" &&& 'LT) ()

-- Present (4,("sadf",LT)) ('(4,("sadf",LT)))

-- Val (4,("sadf",LT))

--

-- >>> pl @(Id &&& '() &&& ()) (Just 10)

-- Present (Just 10,((),())) ('(Just 10,((),())))

-- Val (Just 10,((),()))

--

-- >>> pl @(Fst &&& Snd &&& Thd &&& ()) (1,'x',True)

-- Present (1,('x',(True,()))) ('(1,('x',(True,()))))

-- Val (1,('x',(True,())))

--

-- >>> pl @(Fst &&& Snd &&& Thd &&& ()) (1,'x',True)

-- Present (1,('x',(True,()))) ('(1,('x',(True,()))))

-- Val (1,('x',(True,())))

--

-- >>> pl @(Fst &&& Snd &&& Thd &&& ()) (1,1.4,"aaa")

-- Present (1,(1.4,("aaa",()))) ('(1,(1.4,("aaa",()))))

-- Val (1,(1.4,("aaa",())))

--

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
infixr 3 &&&
type WAmpT p q = W '(p, q)

instance P (WAmpT p q) x => P (p &&& q) x where
  type PP (p &&& q) x = PP (WAmpT p q) x
  eval :: proxy (p &&& q) -> POpts -> x -> m (TT (PP (p &&& q) x))
eval proxy (p &&& q)
_ = Proxy (WAmpT p q) -> POpts -> x -> m (TT (PP (WAmpT 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 (WAmpT p q)
forall k (t :: k). Proxy t
Proxy @(WAmpT p q))

-- | similar to 'Control.Arrow.***'

--

-- >>> pz @(Pred *** ShowP Id) (13, True)

-- Val (12,"True")

--

-- >>> pl @(Flip (***) Len (Id * 12)) (99,"cdef")

-- Present (1188,4) ((***) (1188,4) | (99,"cdef"))

-- Val (1188,4)

--

-- >>> pl @(4 *** "sadf" *** 'LT) ('x',("abv",[1]))

-- Present (4,("sadf",LT)) ((***) (4,("sadf",LT)) | ('x',("abv",[1])))

-- Val (4,("sadf",LT))

--

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
infixr 3 ***

instance ( Show (PP p a)
         , Show (PP q b)
         , P p a
         , P q b
         , Show a
         , Show b
         ) => P (p *** q) (a,b) where
  type PP (p *** q) (a,b) = (PP p a, PP q b)
  eval :: proxy (p *** q) -> POpts -> (a, b) -> m (TT (PP (p *** q) (a, b)))
eval proxy (p *** q)
_ POpts
opts (a
a,b
b) = do
    let msg0 :: String
msg0 = String
"(***)"
    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
    case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT (PP p a, PP q b)) (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 (PP p a, PP q b)
e -> TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP q b)
e
      Right PP p a
a1 -> do
        TT (PP q b)
qq <- 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 b
b
        TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a, PP q b) -> m (TT (PP p a, PP q b)))
-> TT (PP p a, PP q b) -> m (TT (PP p a, PP q b))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP q b)
-> [Tree PE]
-> Either (TT (PP p a, PP q b)) (PP q b)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP q b)
qq [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp] of
          Left TT (PP p a, PP q b)
e -> TT (PP p a, PP q b)
e
          Right PP q b
b1 -> POpts
-> Val (PP p a, PP q b)
-> String
-> [Tree PE]
-> TT (PP p a, PP q b)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP p a, PP q b) -> Val (PP p a, PP q b)
forall a. a -> Val a
Val (PP p a
a1,PP q b
b1)) (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, PP q b) -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts (PP p a
a1,PP q b
b1) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> (a, b) -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " (a
a,b
b)) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q b)
qq]

-- | applies a function against the first part of a tuple: similar to 'Control.Arrow.first'

--

-- >>> pz @(First Succ) (12,True)

-- Val (13,True)

--

data First p deriving Int -> First p -> ShowS
[First p] -> ShowS
First p -> String
(Int -> First p -> ShowS)
-> (First p -> String) -> ([First p] -> ShowS) -> Show (First p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> First p -> ShowS
forall k (p :: k). [First p] -> ShowS
forall k (p :: k). First p -> String
showList :: [First p] -> ShowS
$cshowList :: forall k (p :: k). [First p] -> ShowS
show :: First p -> String
$cshow :: forall k (p :: k). First p -> String
showsPrec :: Int -> First p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> First p -> ShowS
Show
type FirstT p = p *** Id

instance P (FirstT p) x => P (First p) x where
  type PP (First p) x = PP (FirstT p) x
  eval :: proxy (First p) -> POpts -> x -> m (TT (PP (First p) x))
eval proxy (First p)
_ = Proxy (FirstT p) -> POpts -> x -> m (TT (PP (FirstT 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 (FirstT p)
forall k (t :: k). Proxy t
Proxy @(FirstT p))

-- | applies a function against the second part of a tuple: similar to 'Control.Arrow.second'

--

-- >>> pz @(Second Succ) (12,False)

-- Val (12,True)

--

data Second q deriving Int -> Second q -> ShowS
[Second q] -> ShowS
Second q -> String
(Int -> Second q -> ShowS)
-> (Second q -> String) -> ([Second q] -> ShowS) -> Show (Second q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (q :: k). Int -> Second q -> ShowS
forall k (q :: k). [Second q] -> ShowS
forall k (q :: k). Second q -> String
showList :: [Second q] -> ShowS
$cshowList :: forall k (q :: k). [Second q] -> ShowS
show :: Second q -> String
$cshow :: forall k (q :: k). Second q -> String
showsPrec :: Int -> Second q -> ShowS
$cshowsPrec :: forall k (q :: k). Int -> Second q -> ShowS
Show
type SecondT q = Id *** q

instance P (SecondT q) x => P (Second q) x where
  type PP (Second q) x = PP (SecondT q) x
  eval :: proxy (Second q) -> POpts -> x -> m (TT (PP (Second q) x))
eval proxy (Second q)
_ = Proxy (SecondT q) -> POpts -> x -> m (TT (PP (SecondT 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 (SecondT q)
forall k (t :: k). Proxy t
Proxy @(SecondT q))

-- | applies @p@ to lhs of the tuple and @q@ to the rhs and then @ands@ them together: see '&*'

--

-- >>> pl @(AndA (Gt 3) (Lt 10) Id) (1,2)

-- False (False (&*) True | (1 > 3))

-- Val False

--

data AndA p q r deriving Int -> AndA p q r -> ShowS
[AndA p q r] -> ShowS
AndA p q r -> String
(Int -> AndA p q r -> ShowS)
-> (AndA p q r -> String)
-> ([AndA p q r] -> ShowS)
-> Show (AndA 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 -> AndA p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). [AndA p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). AndA p q r -> String
showList :: [AndA p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k). [AndA p q r] -> ShowS
show :: AndA p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k). AndA p q r -> String
showsPrec :: Int -> AndA p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k). Int -> AndA p q r -> ShowS
Show
instance ( PP r x ~ (a,b)
         , PP p a ~ Bool
         , PP q b ~ Bool
         , P p a
         , P q b
         , P r x
         ) => P (AndA p q r) x where
  type PP (AndA p q r) x = Bool
  eval :: proxy (AndA p q r) -> POpts -> x -> m (TT (PP (AndA p q r) x))
eval proxy (AndA p q r)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"(&*)"
    TT (a, b)
rr <- Proxy r -> POpts -> x -> m (TT (PP 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 r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts x
x
    case Inline
-> POpts
-> String
-> TT (a, b)
-> [Tree PE]
-> Either (TT Bool) (a, b)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (a, b)
rr [] of
      Left TT Bool
e -> TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT Bool
e
      Right (a
r1,b
r2) -> do
        TT Bool
pp <- Proxy p -> POpts -> a -> m (TT (PP p 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 p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
r1
        case Inline
-> POpts -> String -> TT Bool -> [Tree PE] -> Either (TT Bool) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Bool
pp [TT (a, b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (a, b)
rr] of
          Left TT Bool
e -> TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT Bool
e
          Right Bool
p -> do
            TT Bool
qq <- Proxy q -> POpts -> b -> m (TT (PP q b))
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 q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts b
r2
            TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT Bool -> [Tree PE] -> Either (TT Bool) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Bool
qq [TT (a, b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (a, b)
rr, TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp] of
              Left TT Bool
e -> TT Bool
e
              Right Bool
q ->
                let zz :: String
zz = case (Bool
p,Bool
q) of
                          (Bool
True, Bool
True) -> String
""
                          (Bool
False, Bool
True) -> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
pp
                          (Bool
True, Bool
False) -> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
qq
                          (Bool
False, Bool
False) -> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
pp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
qq
                in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts (Bool
pBool -> Bool -> Bool
&&Bool
q) (POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ShowS
joinStrings (POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
q) String
zz) [TT (a, b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (a, b)
rr, TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp, TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
qq]

-- | applies @p@ to lhs of the tuple and @q@ to the rhs and then @Ands@ them together

--

-- >>> pl @(SplitAt 4 "abcdefg" >> Len > 4 &* Len < 5) ()

-- False ((>>) False | {False (&*) True | (4 > 4)})

-- Val False

--

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 AndAT p q = AndA p q Id
infixr 3 &*

instance P (AndAT p q) x => P (p &* q) x where
  type PP (p &* q) x = PP (AndAT p q) x
  eval :: proxy (p &* q) -> POpts -> x -> m (TT (PP (p &* q) x))
eval proxy (p &* q)
_ = Proxy (AndAT p q) -> POpts -> x -> m (TT (PP (AndAT p q) x))
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 (AndAT p q)
forall k (t :: k). Proxy t
Proxy @(AndAT p q))

-- | applies @p@ to lhs of the tuple and @q@ to the rhs and then @ors@ them together: see '|+'

--

-- >>> pl @(OrA (Gt 3) (Lt 10) Id) (1,2)

-- True (False (|+) True)

-- Val True

--

data OrA p q r deriving Int -> OrA p q r -> ShowS
[OrA p q r] -> ShowS
OrA p q r -> String
(Int -> OrA p q r -> ShowS)
-> (OrA p q r -> String)
-> ([OrA p q r] -> ShowS)
-> Show (OrA 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 -> OrA p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). [OrA p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). OrA p q r -> String
showList :: [OrA p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k). [OrA p q r] -> ShowS
show :: OrA p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k). OrA p q r -> String
showsPrec :: Int -> OrA p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k). Int -> OrA p q r -> ShowS
Show
instance ( PP r x ~ (a,b)
         , PP p a ~ Bool
         , PP q b ~ Bool
         , P p a
         , P q b
         , P r x
         ) => P (OrA p q r) x where
  type PP (OrA p q r) x = Bool
  eval :: proxy (OrA p q r) -> POpts -> x -> m (TT (PP (OrA p q r) x))
eval proxy (OrA p q r)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"(|+)"
    TT (a, b)
rr <- Proxy r -> POpts -> x -> m (TT (PP 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 r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts x
x
    case Inline
-> POpts
-> String
-> TT (a, b)
-> [Tree PE]
-> Either (TT Bool) (a, b)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (a, b)
rr [] of
      Left TT Bool
e -> TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT Bool
e
      Right (a
r1,b
r2) -> do
        TT Bool
pp <- Proxy p -> POpts -> a -> m (TT (PP p 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 p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
r1
        case Inline
-> POpts -> String -> TT Bool -> [Tree PE] -> Either (TT Bool) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Bool
pp [TT (a, b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (a, b)
rr] of
          Left TT Bool
e -> TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT Bool
e
          Right Bool
p -> do
            TT Bool
qq <- Proxy q -> POpts -> b -> m (TT (PP q b))
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 q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts b
r2
            TT Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT Bool -> [Tree PE] -> Either (TT Bool) Bool
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Bool
qq [TT (a, b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (a, b)
rr, TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp] of
              Left TT Bool
e -> TT Bool
e
              Right Bool
q ->
                let zz :: String
zz = case (Bool
p,Bool
q) of
                          (Bool
False,Bool
False) -> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
pp String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TT Bool -> String
forall a. TT a -> String
topMessage TT Bool
qq
                          (Bool, Bool)
_ -> String
""
                in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts (Bool
pBool -> Bool -> Bool
||Bool
q) (POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String -> ShowS
joinStrings (POpts -> Bool -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Bool
q) String
zz) [TT (a, b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (a, b)
rr, TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
pp, TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
qq]

-- | applies @p@ to lhs of the tuple and @q@ to the rhs and then @Ors@ them together

--

-- >>> pl @(Sum > 44 |+ Id < 2) ([5,6,7,8,14,44],9)

-- True (True (|+) False)

-- Val True

--

-- >>> pl @(Sum > 44 |+ Id < 2) ([5,6,7,14],9)

-- False (False (|+) False | (32 > 44) (|+) (9 < 2))

-- Val False

--

-- >>> pl @(Sum > 44 |+ Id < 2) ([5,6,7,14],1)

-- True (False (|+) True)

-- Val True

--

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 OrAT p q = OrA p q Id
infixr 3 |+

instance P (OrAT p q) x => P (p |+ q) x where
  type PP (p |+ q) x = PP (OrAT p q) x
  eval :: proxy (p |+ q) -> POpts -> x -> m (TT (PP (p |+ q) x))
eval proxy (p |+ q)
_ = Proxy (OrAT p q) -> POpts -> x -> m (TT (PP (OrAT p q) x))
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 (OrAT p q)
forall k (t :: k). Proxy t
Proxy @(OrAT p q))

-- | applies @p@ to the first and second slot of an n-tuple (similar to '***')

--

-- >>> pl @(Fst >> Both Len) (("abc",[10..17]),True)

-- Present (3,8) ((>>) (3,8) | {Both})

-- Val (3,8)

--

-- >>> pl @(Lift (Both Pred) Fst) ((12,'z'),True)

-- Present (11,'y') ((>>) (11,'y') | {Both})

-- Val (11,'y')

--

-- >>> pl @(Both Succ) (4,'a')

-- Present (5,'b') (Both)

-- Val (5,'b')

--

-- >>> import Data.Time

-- >>> pl @(Both (ReadP Day Id)) ("1999-01-01","2001-02-12")

-- Present (1999-01-01,2001-02-12) (Both)

-- Val (1999-01-01,2001-02-12)

--

-- >>> pz @(Both (Id * Id) >> ((Fst + Snd) ** (DivI Double 1 2))) (3,4)

-- Val 5.0

--

data Both p deriving Int -> Both p -> ShowS
[Both p] -> ShowS
Both p -> String
(Int -> Both p -> ShowS)
-> (Both p -> String) -> ([Both p] -> ShowS) -> Show (Both p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Both p -> ShowS
forall k (p :: k). [Both p] -> ShowS
forall k (p :: k). Both p -> String
showList :: [Both p] -> ShowS
$cshowList :: forall k (p :: k). [Both p] -> ShowS
show :: Both p -> String
$cshow :: forall k (p :: k). Both p -> String
showsPrec :: Int -> Both p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Both p -> ShowS
Show
instance ( P p a
         , P p a'
   ) => P (Both p) (a,a') where
  type PP (Both p) (a,a') = (PP p a, PP p a')
  eval :: proxy (Both p) -> POpts -> (a, a') -> m (TT (PP (Both p) (a, a')))
eval proxy (Both p)
_ POpts
opts (a
a,a'
a') = do
    let msg0 :: String
msg0 = String
"Both"
    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
    case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT (PP p a, 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 TT (PP p a)
pp [] of
      Left TT (PP p a, PP p a')
e -> TT (PP p a, PP p a') -> m (TT (PP p a, PP p a'))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p a, PP p a')
e
      Right PP p a
b -> 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'
a'
        TT (PP p a, PP p a') -> m (TT (PP p a, PP p a'))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a, PP p a') -> m (TT (PP p a, PP p a')))
-> TT (PP p a, PP p a') -> m (TT (PP p a, PP p a'))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p a')
-> [Tree PE]
-> Either (TT (PP p a, 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 TT (PP p a')
pp' [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp] of
          Left TT (PP p a, PP p a')
e -> TT (PP p a, PP p a')
e
          Right PP p a'
b' ->
            POpts
-> Val (PP p a, PP p a')
-> String
-> [Tree PE]
-> TT (PP p a, PP p a')
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP p a, PP p a') -> Val (PP p a, PP p a')
forall a. a -> Val a
Val (PP p a
b,PP p a'
b')) String
msg0 [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP p a') -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a')
pp']

-- | similar to 'Data.Function.on'

--

-- >>> pz @(On' (==!) Len Fst (Reverse << Snd)) ("1ss","x2")

-- Val GT

--

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

instance ( P q (PP r x)
         , P q (PP s x)
         , P r x
         , P s x
         , P (p Fst Snd) (PP q (PP r x), PP q (PP s x))
   ) => P (On' p q r s) x where
  type PP (On' p q r s) x = PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))
  eval :: proxy (On' p q r s) -> POpts -> x -> m (TT (PP (On' p q r s) x))
eval proxy (On' p q r s)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"On'"
    Either
  (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))))
  (PP r x, PP s x, TT (PP r x), TT (PP s x))
lr <- Inline
-> String
-> Proxy r
-> Proxy s
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))))
        (PP r x, PP s x, TT (PP r x), TT (PP s 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 r
forall k (t :: k). Proxy t
Proxy @r) (Proxy s
forall k (t :: k). Proxy t
Proxy @s) POpts
opts x
x []
    case Either
  (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))))
  (PP r x, PP s x, TT (PP r x), TT (PP s x))
lr of
      Left TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
e -> TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
-> m (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
e
      Right (PP r x
r,PP s x
s,TT (PP r x)
rr,TT (PP s x)
ss) -> do
        let hhs :: [Tree PE]
hhs = [TT (PP r x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP r x)
rr, TT (PP s x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP s x)
ss]
        TT (PP q (PP r x))
qq <- Proxy q -> POpts -> PP r x -> m (TT (PP q (PP 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 q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts PP r x
r
        case Inline
-> POpts
-> String
-> TT (PP q (PP r x))
-> [Tree PE]
-> Either
     (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))))
     (PP q (PP r 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 (PP r x))
qq [Tree PE]
hhs of
          Left TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
e -> TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
-> m (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
e
          Right PP q (PP r x)
b -> do
            TT (PP q (PP s x))
qq' <- Proxy q -> POpts -> PP s x -> m (TT (PP q (PP 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 q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts PP s x
s
            case Inline
-> POpts
-> String
-> TT (PP q (PP s x))
-> [Tree PE]
-> Either
     (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))))
     (PP q (PP s 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 (PP s x))
qq' ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT (PP q (PP r x)) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q (PP r x))
qq]) of
              Left TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
e -> TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
-> m (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
e
              Right PP q (PP s x)
b' -> do
                TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
pp <- Proxy (p Fst Snd)
-> POpts
-> (PP q (PP r x), PP q (PP s x))
-> m (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP 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 (p Fst Snd)
forall k (t :: k). Proxy t
Proxy @(p Fst Snd)) POpts
opts (PP q (PP r x)
b,PP q (PP s x)
b')
                let hhs1 :: [Tree PE]
hhs1 = [Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT (PP q (PP r x)) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q (PP r x))
qq, TT (PP q (PP s x)) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q (PP s x))
qq']
                TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
-> m (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
 -> m (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))))
-> TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
-> m (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
-> [Tree PE]
-> Either
     (TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))))
     (PP (p Fst Snd) (PP q (PP r x), PP q (PP s 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 Fst Snd) (PP q (PP r x), PP q (PP s x)))
pp [Tree PE]
hhs1 of
                  Left TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
e -> TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
e
                  Right PP (p Fst Snd) (PP q (PP r x), PP q (PP s x))
_ -> POpts
-> TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
-> String
-> [Tree PE]
-> TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT (PP (p Fst Snd) (PP q (PP r x), PP q (PP s x)))
pp String
msg0 [Tree PE]
hhs1 -- so we can preserve ValP


-- | similar to 'Data.Function.on' for tuples

--

-- >>> pz @(On (==!) Len) ("1ss","x2") -- or use Comparing or Both+Compare

-- Val GT

--

-- >>> pz @('(4,2) >> On (**) (FromIntegral _)) ()

-- Val 16.0

--

-- >>> pz @('(4,2) >> Both (FromIntegral _) >> Fst ** Snd) () -- equivalent to the above

-- Val 16.0

--

-- >>> pz @(On (+) (Id * Id) >> Id ** (1 % 2 >> FromRational _)) (3,4)

-- Val 5.0

--

-- >>> pz @(Both (Id * Id) >> ((Fst + Snd) ** (1 % 2 >> FromRational _))) (3,4) -- equivalent to the above

-- Val 5.0

--

-- >>> pz @(On (<>) (Pure [] Id)) ('x','y')

-- Val "xy"

--

-- >>> pz @(On (Flip (<>)) (Pure [] Id)) ('x','y')

-- Val "yx"

--

-- >>> pz @(On (Flip (<>)) (Pure _ Id) >> '(Len,Head,Last)) ('x','y')

-- Val (2,'y','x')

--

data On (p :: Type -> Type -> k) q deriving Int -> On p q -> ShowS
[On p q] -> ShowS
On p q -> String
(Int -> On p q -> ShowS)
-> (On p q -> String) -> ([On p q] -> ShowS) -> Show (On p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: Type -> Type -> k) k (q :: k).
Int -> On p q -> ShowS
forall k (p :: Type -> Type -> k) k (q :: k). [On p q] -> ShowS
forall k (p :: Type -> Type -> k) k (q :: k). On p q -> String
showList :: [On p q] -> ShowS
$cshowList :: forall k (p :: Type -> Type -> k) k (q :: k). [On p q] -> ShowS
show :: On p q -> String
$cshow :: forall k (p :: Type -> Type -> k) k (q :: k). On p q -> String
showsPrec :: Int -> On p q -> ShowS
$cshowsPrec :: forall k (p :: Type -> Type -> k) k (q :: k).
Int -> On p q -> ShowS
Show
type OnT p q = On' p q Fst Snd

instance P (OnT p q) x => P (On p q) x where
  type PP (On p q) x = PP (OnT p q) x
  eval :: proxy (On p q) -> POpts -> x -> m (TT (PP (On p q) x))
eval proxy (On p q)
_ = Proxy (OnT p q) -> POpts -> x -> m (TT (PP (OnT 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 (OnT p q)
forall k (t :: k). Proxy t
Proxy @(OnT p q))

-- | similar to 'uncurry'

--

-- >>> pl @(Uncurry (==)) ('x','x')

-- True (On')

-- Val True

--

-- >>> pz @(Uncurry (.&.)) (7,15)

-- Val 7

--

-- >>> pz @(Uncurry (+)) (7,15)

-- Val 22

--

-- >>> pz @(Uncurry (*)) (7,15)

-- Val 105

--

-- >>> pz @(Uncurry '(,)) (7,15)

-- Val (7,15)

--

-- >>> pz @(Uncurry ('(,,) 4)) ('x',True)

-- Val (4,'x',True)

--

-- >>> pz @(Uncurry (Flip '(,))) (1,'x')

-- Val ('x',1)

--

-- >>> pz @(Uncurry (<>)) ("ab","def")

-- Val "abdef"

--

-- >>> pz @(Uncurry (<>)) (SG.Sum 12,SG.Sum 99)

-- Val (Sum {getSum = 111})

--

data Uncurry (p :: Type -> Type -> k) deriving Int -> Uncurry p -> ShowS
[Uncurry p] -> ShowS
Uncurry p -> String
(Int -> Uncurry p -> ShowS)
-> (Uncurry p -> String)
-> ([Uncurry p] -> ShowS)
-> Show (Uncurry p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: Type -> Type -> k). Int -> Uncurry p -> ShowS
forall k (p :: Type -> Type -> k). [Uncurry p] -> ShowS
forall k (p :: Type -> Type -> k). Uncurry p -> String
showList :: [Uncurry p] -> ShowS
$cshowList :: forall k (p :: Type -> Type -> k). [Uncurry p] -> ShowS
show :: Uncurry p -> String
$cshow :: forall k (p :: Type -> Type -> k). Uncurry p -> String
showsPrec :: Int -> Uncurry p -> ShowS
$cshowsPrec :: forall k (p :: Type -> Type -> k). Int -> Uncurry p -> ShowS
Show
type UncurryT p = On p Id

instance P (UncurryT p) x => P (Uncurry p) x where
  type PP (Uncurry p) x = PP (UncurryT p) x
  eval :: proxy (Uncurry p) -> POpts -> x -> m (TT (PP (Uncurry p) x))
eval proxy (Uncurry p)
_ = Proxy (UncurryT p) -> POpts -> x -> m (TT (PP (UncurryT 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 (UncurryT p)
forall k (t :: k). Proxy t
Proxy @(UncurryT p))

-- | create a @n@ tuple from a list or fail

--

-- >>> pz @(Tuple 4) "abcdefg"

-- Val ('a','b','c','d')

--

-- >>> pz @(Tuple 4) "abc"

-- Fail "Tuple(4) not enough elements(3)"

--

-- >>> pz @(Fst >> Tuple 3) ([1..5],True)

-- Val (1,2,3)

--

-- >>> pz @(Lift (Tuple 3) Fst) ([1..5],True)

-- Val (1,2,3)

--

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

instance ( KnownNat n
         , FailWhenT (n GL.<=? 1)
                  ('GL.Text "Tuple:n cannot be less than two but found n="
                   'GL.:<>: 'GL.ShowType n)
         , TupleC n a
         , x ~ [a]
         , Show a
         ) => P (Tuple n) x where
  type PP (Tuple n) x = TupleT n (ExtractAFromList x)
  eval :: proxy (Tuple n) -> POpts -> x -> m (TT (PP (Tuple n) x))
eval proxy (Tuple n)
_ POpts
opts x
xs' =
    let msg0 :: String
msg0 = String
"Tuple(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
        n :: Int
n = (KnownNat n, Num Int) => Int
forall (n :: Nat) a. (KnownNat n, Num a) => a
nat @n @Int
    in TT (TupleT n a) -> m (TT (TupleT n a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (TupleT n a) -> m (TT (TupleT n a)))
-> TT (TupleT n a) -> m (TT (TupleT n a))
forall a b. (a -> b) -> a -> b
$ case POpts
-> String
-> [a]
-> [Tree PE]
-> Either (TT (TupleT n a)) (Int, [a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 x
[a]
xs' [] of
        Left TT (TupleT n a)
e -> TT (TupleT n a)
e
        Right (Int
xsLen,[a]
xs) ->
          case [a] -> Maybe (TupleT n a)
forall (n :: Nat) a. TupleC n a => [a] -> Maybe (TupleT n a)
getTupleC @n [a]
xs of
            Maybe (TupleT n a)
Nothing -> POpts -> Val (TupleT n a) -> String -> [Tree PE] -> TT (TupleT n a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (TupleT n a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" not enough elements(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
xsLen String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")")) (POpts -> String -> [a] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " [a]
xs) []
            Just TupleT n a
r -> POpts -> Val (TupleT n a) -> String -> [Tree PE] -> TT (TupleT n a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (TupleT n a -> Val (TupleT n a)
forall a. a -> Val a
Val TupleT n a
r) String
msg0 []

-- | create a @n@ tuple from a list and return as an Either

--

-- >>> pz @(Tuple' 4) "abcdefg"

-- Val (Right ('a','b','c','d'))

--

-- >>> pz @(Tuple' 4) []

-- Val (Left [])

--

-- >>> pl @(Tuple' 4) "abc"

-- Present Left "abc" (Tuple'(4) not enough elements(3))

-- Val (Left "abc")

--

-- >>> :set -XPolyKinds

-- >>> type F n i = ChunksOf' n i Id >> Map (Tuple' n) >> PartitionEithers

-- >>> pz @(F 3 1) [1..7]

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

--

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

instance ( KnownNat n
         , FailWhenT (n GL.<=? 1)
                  ('GL.Text "Tuple':n cannot be less than two but found n="
                   'GL.:<>: 'GL.ShowType n)
         , TupleC n a
         , x ~ [a]
         ) => P (Tuple' n) x where
  type PP (Tuple' n) x = Either x (TupleT n (ExtractAFromList x))
  eval :: proxy (Tuple' n) -> POpts -> x -> m (TT (PP (Tuple' n) x))
eval proxy (Tuple' n)
_ POpts
opts x
xs' =
    let msg0 :: String
msg0 = String
"Tuple'(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
        n :: Int
n = (KnownNat n, Num Int) => Int
forall (n :: Nat) a. (KnownNat n, Num a) => a
nat @n @Int
    in TT (Either [a] (TupleT n a)) -> m (TT (Either [a] (TupleT n a)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Either [a] (TupleT n a)) -> m (TT (Either [a] (TupleT n a))))
-> TT (Either [a] (TupleT n a)) -> m (TT (Either [a] (TupleT n a)))
forall a b. (a -> b) -> a -> b
$ case POpts
-> String
-> [a]
-> [Tree PE]
-> Either (TT (Either [a] (TupleT n a))) (Int, [a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 x
[a]
xs' [] of
      Left TT (Either [a] (TupleT n a))
e -> TT (Either [a] (TupleT n a))
e
      Right (Int
xsLen,[a]
xs) ->
        let lr :: Maybe (TupleT n a)
lr = [a] -> Maybe (TupleT n a)
forall (n :: Nat) a. TupleC n a => [a] -> Maybe (TupleT n a)
getTupleC @n [a]
xs
        in case Maybe (TupleT n a)
lr of
             Maybe (TupleT n a)
Nothing -> POpts
-> Val (Either [a] (TupleT n a))
-> String
-> [Tree PE]
-> TT (Either [a] (TupleT n a))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Either [a] (TupleT n a) -> Val (Either [a] (TupleT n a))
forall a. a -> Val a
Val ([a] -> Either [a] (TupleT n a)
forall a b. a -> Either a b
Left [a]
xs)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" not enough elements(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
xsLen String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")") []
             Just TupleT n a
ret -> POpts
-> Val (Either [a] (TupleT n a))
-> String
-> [Tree PE]
-> TT (Either [a] (TupleT n a))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Either [a] (TupleT n a) -> Val (Either [a] (TupleT n a))
forall a. a -> Val a
Val (TupleT n a -> Either [a] (TupleT n a)
forall a b. b -> Either a b
Right TupleT n a
ret)) String
msg0 []

-- | run @p@ with inductive tuples

--

-- >>> pz @(EachITuple Succ) (False,(2,(LT,('c',()))))

-- Val (True,(3,(EQ,('d',()))))

--

-- >>> pz @(EachITuple (Id + (4 >> FromIntegral _))) (1,(1/4,(5%6,())))

-- Val (5 % 1,(17 % 4,(29 % 6,())))

--

-- >>> pz @(ToITuple >> EachITuple (Id + (4 >> FromIntegral _))) (1000,1/4,5%6)

-- Val (1004 % 1,(17 % 4,(29 % 6,())))

--

-- >>> pz @(ToITuple >> EachITuple ((Id >> FromIntegral _) + (4 >> FromIntegral _))) (1000::Integer,17::Int)

-- Val (1004,(21,()))

--

-- >>> pz @(ToITuple >> EachITuple (Dup >> Fst<>Snd)) (SG.Min 1,SG.First 'x',"abcd")

-- Val (Min {getMin = 1},(First {getFirst = 'x'},("abcdabcd",())))

--

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

instance ( P p b
         , P (EachITuple p) bs
         ) => P (EachITuple p) (b,bs) where
  type PP (EachITuple p) (b,bs) = (PP p b, PP (EachITuple p) bs)
  eval :: proxy (EachITuple p)
-> POpts -> (b, bs) -> m (TT (PP (EachITuple p) (b, bs)))
eval proxy (EachITuple p)
_ POpts
opts (b
b,bs
bs) = do
    let msg0 :: String
msg0 = String
"EachITuple"
    TT (PP p b)
pp <- Proxy p -> POpts -> b -> m (TT (PP p 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 p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts b
b
    case Inline
-> POpts
-> String
-> TT (PP p b)
-> [Tree PE]
-> Either (TT (PP p b, PP (EachITuple p) bs)) (PP p b)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p b)
pp [] of
      Left TT (PP p b, PP (EachITuple p) bs)
e -> TT (PP p b, PP (EachITuple p) bs)
-> m (TT (PP p b, PP (EachITuple p) bs))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP p b, PP (EachITuple p) bs)
e
      Right PP p b
p -> do
        TT (PP (EachITuple p) bs)
qq <- Proxy (EachITuple p)
-> POpts -> bs -> m (TT (PP (EachITuple p) bs))
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 (EachITuple p)
forall k (t :: k). Proxy t
Proxy @(EachITuple p)) POpts
opts bs
bs
        TT (PP p b, PP (EachITuple p) bs)
-> m (TT (PP p b, PP (EachITuple p) bs))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p b, PP (EachITuple p) bs)
 -> m (TT (PP p b, PP (EachITuple p) bs)))
-> TT (PP p b, PP (EachITuple p) bs)
-> m (TT (PP p b, PP (EachITuple p) bs))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP (EachITuple p) bs)
-> [Tree PE]
-> Either
     (TT (PP p b, PP (EachITuple p) bs)) (PP (EachITuple p) bs)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP (EachITuple p) bs)
qq [] of
          Left TT (PP p b, PP (EachITuple p) bs)
e -> TT (PP p b, PP (EachITuple p) bs)
e
          Right PP (EachITuple p) bs
q ->
            TT (PP (EachITuple p) bs)
qq TT (PP (EachITuple p) bs)
-> (TT (PP (EachITuple p) bs) -> TT (PP p b, PP (EachITuple p) bs))
-> TT (PP p b, PP (EachITuple p) bs)
forall a b. a -> (a -> b) -> b
& (Val (PP (EachITuple p) bs)
 -> Identity (Val (PP p b, PP (EachITuple p) bs)))
-> TT (PP (EachITuple p) bs)
-> Identity (TT (PP p b, PP (EachITuple p) bs))
forall a b. Lens (TT a) (TT b) (Val a) (Val b)
ttVal ((Val (PP (EachITuple p) bs)
  -> Identity (Val (PP p b, PP (EachITuple p) bs)))
 -> TT (PP (EachITuple p) bs)
 -> Identity (TT (PP p b, PP (EachITuple p) bs)))
-> Val (PP p b, PP (EachITuple p) bs)
-> TT (PP (EachITuple p) bs)
-> TT (PP p b, PP (EachITuple p) bs)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (PP p b, PP (EachITuple p) bs)
-> Val (PP p b, PP (EachITuple p) bs)
forall a. a -> Val a
Val (PP p b
p,PP (EachITuple p) bs
q)
               TT (PP p b, PP (EachITuple p) bs)
-> (TT (PP p b, PP (EachITuple p) bs)
    -> TT (PP p b, PP (EachITuple p) bs))
-> TT (PP p b, PP (EachITuple p) bs)
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE])
-> TT (PP p b, PP (EachITuple p) bs)
-> Identity (TT (PP p b, PP (EachITuple p) bs))
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE])
 -> TT (PP p b, PP (EachITuple p) bs)
 -> Identity (TT (PP p b, PP (EachITuple p) bs)))
-> ([Tree PE] -> [Tree PE])
-> TT (PP p b, PP (EachITuple p) bs)
-> TT (PP p b, PP (EachITuple p) bs)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (TT (PP p b) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p b)
ppTree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
:)

instance P (EachITuple p) () where
  type PP (EachITuple p) () = ()
  eval :: proxy (EachITuple p)
-> POpts -> () -> m (TT (PP (EachITuple p) ()))
eval proxy (EachITuple p)
_ POpts
opts () = do
    let msg0 :: String
msg0 = String
"EachITuple"
    TT () -> m (TT ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT () -> m (TT ())) -> TT () -> m (TT ())
forall a b. (a -> b) -> a -> b
$ POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (() -> Val ()
forall a. a -> Val a
Val ()) String
msg0 []

-- | create inductive tuples from flat tuples

--

-- >>> pz @(ToITuple >> EachITuple Succ) (1,2,False,'x')

-- Val (2,(3,(True,('y',()))))

--

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

instance ToITupleC x => P ToITuple x where
  type PP ToITuple x = ToITupleP x
  eval :: proxy ToITuple -> POpts -> x -> m (TT (PP ToITuple x))
eval proxy ToITuple
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ToITuple"
    TT (ToITupleP x) -> m (TT (ToITupleP x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ToITupleP x) -> m (TT (ToITupleP x)))
-> TT (ToITupleP x) -> m (TT (ToITupleP x))
forall a b. (a -> b) -> a -> b
$ POpts
-> Val (ToITupleP x) -> String -> [Tree PE] -> TT (ToITupleP x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ToITupleP x -> Val (ToITupleP x)
forall a. a -> Val a
Val (x -> ToITupleP x
forall x. ToITupleC x => x -> ToITupleP x
toITupleC x
x)) String
msg0 []

-- | create flat tuples from inductive tuples

--

-- >>> pz @FromITuple (2,(3,(True,('y',()))))

-- Val (2,3,True,'y')

--

-- >>> pz @FromITuple ()

-- Val ()

--

-- >>> pz @FromITuple (1,())

-- Val 1

--

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

instance FromITupleC x => P FromITuple x where
  type PP FromITuple x = FromITupleP x
  eval :: proxy FromITuple -> POpts -> x -> m (TT (PP FromITuple x))
eval proxy FromITuple
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"FromITuple"
    TT (FromITupleP x) -> m (TT (FromITupleP x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (FromITupleP x) -> m (TT (FromITupleP x)))
-> TT (FromITupleP x) -> m (TT (FromITupleP x))
forall a b. (a -> b) -> a -> b
$ POpts
-> Val (FromITupleP x) -> String -> [Tree PE] -> TT (FromITupleP x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (FromITupleP x -> Val (FromITupleP x)
forall a. a -> Val a
Val (x -> FromITupleP x
forall x. FromITupleC x => x -> FromITupleP x
fromITupleC x
x)) String
msg0 []

-- | reverse an inductive tuple

--

-- >>> pz @ReverseITuple (1.4,(1,(2,(False,('x',())))))

-- Val ('x',(False,(2,(1,(1.4,())))))

--

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

instance P ReverseITuple () where
  type PP ReverseITuple () = ()
  eval :: proxy ReverseITuple -> POpts -> () -> m (TT (PP ReverseITuple ()))
eval proxy ReverseITuple
_ POpts
opts () = do
    let msg0 :: String
msg0 = String
"ReverseITuple"
    TT () -> m (TT ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT () -> m (TT ())) -> TT () -> m (TT ())
forall a b. (a -> b) -> a -> b
$ POpts -> Val () -> String -> [Tree PE] -> TT ()
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (() -> Val ()
forall a. a -> Val a
Val ()) String
msg0 []

instance ReverseITupleC x xs () => P ReverseITuple (x,xs) where
  type PP ReverseITuple (x,xs) = ReverseITupleT x xs ()
  eval :: proxy ReverseITuple
-> POpts -> (x, xs) -> m (TT (PP ReverseITuple (x, xs)))
eval proxy ReverseITuple
_ POpts
opts (x
x,xs
xs) = do
    let msg0 :: String
msg0 = String
"ReverseITuple"
    TT (ReverseITupleT x xs ()) -> m (TT (ReverseITupleT x xs ()))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ReverseITupleT x xs ()) -> m (TT (ReverseITupleT x xs ())))
-> TT (ReverseITupleT x xs ()) -> m (TT (ReverseITupleT x xs ()))
forall a b. (a -> b) -> a -> b
$ POpts
-> Val (ReverseITupleT x xs ())
-> String
-> [Tree PE]
-> TT (ReverseITupleT x xs ())
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ReverseITupleT x xs () -> Val (ReverseITupleT x xs ())
forall a. a -> Val a
Val (x -> xs -> () -> ReverseITupleT x xs ()
forall x xs ys.
ReverseITupleC x xs ys =>
x -> xs -> ys -> ReverseITupleT x xs ys
reverseITupleC x
x xs
xs ())) String
msg0 []

-- | create inductive tuples from a list of the exact size @n@

--

-- >>> pz @(ToITupleList 4 >> EachITuple Succ) ['a','c','y','B']

-- Val ('b',('d',('z',('C',()))))

--

-- >>> pz @(ToITupleList 4) ['a','c','y','B']

-- Val ('a',('c',('y',('B',()))))

--

-- >>> pz @(Take 10 Id >> ToITupleList 10) ['a'..'z']

-- Val ('a',('b',('c',('d',('e',('f',('g',('h',('i',('j',()))))))))))

--

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

instance ( KnownNat n
         , FailWhenT (n GL.<=? 0)
                  ('GL.Text "ToITupleList:n cannot be 0")
         , ToITupleListC n a
         , xs ~ [a]
         ) => P (ToITupleList n) xs where
  type PP (ToITupleList n) xs = ToITupleListP n (ExtractAFromTA xs)
  eval :: proxy (ToITupleList n)
-> POpts -> xs -> m (TT (PP (ToITupleList n) xs))
eval proxy (ToITupleList n)
_ POpts
opts xs
xs' =
    let msg0 :: String
msg0 = String
"ToITupleList(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
        n :: Int
n = (KnownNat n, Num Int) => Int
forall (n :: Nat) a. (KnownNat n, Num a) => a
nat @n @Int
    in TT (ToITupleListP n a) -> m (TT (ToITupleListP n a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ToITupleListP n a) -> m (TT (ToITupleListP n a)))
-> TT (ToITupleListP n a) -> m (TT (ToITupleListP n a))
forall a b. (a -> b) -> a -> b
$ case POpts
-> String
-> [a]
-> [Tree PE]
-> Either (TT (ToITupleListP n a)) (Int, [a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 xs
[a]
xs' [] of
         Left TT (ToITupleListP n a)
e -> TT (ToITupleListP n a)
e
         Right (Int
xsLen,[a]
xs) ->
           case [a] -> Either String (ToITupleListP n a)
forall (n :: Nat) a.
ToITupleListC n a =>
[a] -> Either String (ToITupleListP n a)
toITupleListC @n @a [a]
xs of
             Left String
e -> POpts
-> Val (ToITupleListP n a)
-> String
-> [Tree PE]
-> TT (ToITupleListP n a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (ToITupleListP n a)
forall a. String -> Val a
Fail String
e) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" instead found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
xsLen) []
             Right ToITupleListP n a
d -> POpts
-> Val (ToITupleListP n a)
-> String
-> [Tree PE]
-> TT (ToITupleListP n a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ToITupleListP n a -> Val (ToITupleListP n a)
forall a. a -> Val a
Val ToITupleListP n a
d) String
msg0 []

-- | assoc using 'AssocC'

--

-- >>> pz @Assoc (This (These 123 'x'))

-- Val (These 123 (This 'x'))

--

-- >>> pz @Assoc ((99,'a'),True)

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

--

-- >>> pz @Assoc ((99,'a'),True)

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

--

-- >>> pz @Assoc (Right "Abc" :: Either (Either () ()) String)

-- Val (Right (Right "Abc"))

--

-- >>> pz @Assoc (Left (Left 'x'))

-- Val (Left 'x')

--

-- >>> pl @Assoc ((10,'c'),True)

-- Present (10,('c',True)) (Assoc (10,('c',True)) | ((10,'c'),True))

-- Val (10,('c',True))

--

-- >>> pl @(Assoc >> Unassoc) ((10,'c'),True)

-- Present ((10,'c'),True) ((>>) ((10,'c'),True) | {Unassoc ((10,'c'),True) | (10,('c',True))})

-- Val ((10,'c'),True)

--

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

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

-- | unassoc using 'AssocC'

--

-- >>> pz @Unassoc (These 123 (This 'x'))

-- Val (This (These 123 'x'))

--

-- >>> pz @Unassoc (99,('a',True))

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

--

-- >>> pz @Unassoc (This 10 :: These Int (These Bool ()))

-- Val (This (This 10))

--

-- >>> pz @Unassoc (Right (Right 123))

-- Val (Right 123)

--

-- >>> pz @Unassoc (Left 'x' :: Either Char (Either Bool Double))

-- Val (Left (Left 'x'))

--

-- >>> pl @Unassoc (10,('c',True))

-- Present ((10,'c'),True) (Unassoc ((10,'c'),True) | (10,('c',True)))

-- Val ((10,'c'),True)

--

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

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