{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoStarIsType #-}
{-# LANGUAGE EmptyDataDeriving #-}
module Predicate.Data.List (
type (:+)
, type (+:)
, type (++)
, Singleton
, EmptyT
, EmptyList
, EmptyList'
, Uncons
, Unsnoc
, Head
, Tail
, Init
, Last
, SortBy
, SortOn
, SortOnDesc
, Sort
, Unzip
, Unzip3
, ZipL
, ZipR
, Zip
, ZipWith
, ZipCartesian
, ZipPad
, Partition
, Quant
, All1
, PartitionBy
, Group
, GroupBy
, GroupCnt
, GroupCntStable
, Filter
, Break
, Span
, Intercalate
, Elem
, Inits
, Tails
, Ones
, PadL
, PadR
, SplitAts
, SplitAt
, ChunksOf
, ChunksOf'
, Rotate
, Take
, Drop
, Remove
, Keep
, Reverse
, ReverseL
, Nub
, Sum
, Product
, Min
, Max
, IsPrefix
, IsInfix
, IsSuffix
) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Predicate.Data.Ordering (type (==), OrdA', type (>))
import Predicate.Data.Numeric (Mod)
import Predicate.Data.Monoid (type (<>))
import Control.Lens
import Data.List (foldl', partition, intercalate, inits, tails, unfoldr, sortOn)
import Data.Proxy (Proxy(Proxy))
import Control.Monad (zipWithM)
import Data.Kind (Type)
import Data.Foldable (toList)
import Control.Arrow (Arrow((***), (&&&)))
import qualified Data.Sequence as Seq
import Data.Bool (bool)
import qualified Data.Map.Strict as M
import Control.Applicative (Alternative(empty), liftA2)
import Data.Containers.ListUtils (nubOrd)
import qualified Data.List.NonEmpty as NE
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 5 ++
instance ( P p x
, P q x
, Show (PP p x)
, PP p x ~ [a]
, PP q x ~ [a]
) => 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
z = do
let msg0 :: String
msg0 = String
"(++)"
Either (TT [a]) ([a], [a], TT [a], TT [a])
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT [a]) (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
z []
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 Either (TT [a]) ([a], [a], TT [a], TT [a])
lr of
Left TT [a]
e -> TT [a]
e
Right ([a]
p,[a]
q,TT [a]
pp,TT [a]
qq) ->
let b :: [a]
b = [a]
p [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
q
in 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]
b) (POpts -> String -> [a] -> String -> [a] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [a]
b String
"p=" [a]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [a] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [a]
q) [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
pp, TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
qq]
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 5 :+
instance ( P p x
, P q x
, Show (PP p x)
, Show (PP q x)
, Cons (PP q x) (PP q x) (PP p x) (PP p x)
) => 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
z = do
let msg0 :: String
msg0 = String
"(:+)"
Either (TT (PP q x)) (PP p x, PP q x, TT (PP p x), TT (PP q x))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
(TT (PP q 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
z []
TT (PP q x) -> m (TT (PP q x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q x) -> m (TT (PP q x))) -> TT (PP q x) -> m (TT (PP q x))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q x)) (PP p x, PP q x, TT (PP p x), TT (PP q x))
lr of
Left TT (PP q x)
e -> TT (PP q x)
e
Right (PP p x
p,PP q x
q,TT (PP p x)
pp,TT (PP q x)
qq) ->
let b :: PP q x
b = PP p x
p PP p x -> PP q x -> PP q x
forall s a. Cons s s a a => a -> s -> s
`cons` PP q x
q
in POpts -> Val (PP q x) -> String -> [Tree PE] -> TT (PP q x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q x -> Val (PP q x)
forall a. a -> Val a
Val PP q x
b) (POpts -> String -> PP q x -> String -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 PP q x
b String
"p=" PP p x
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> PP q x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" PP q x
q) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp, TT (PP q x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q x)
qq]
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 5 +:
instance ( P p x
, P q x
, Show (PP q x)
, Show (PP p x)
, Snoc (PP p x) (PP p x) (PP q x) (PP q x)
) => 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
z = do
let msg0 :: String
msg0 = String
"(+:)"
Either (TT (PP p x)) (PP p x, PP q x, TT (PP p x), TT (PP q x))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
(TT (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
z []
TT (PP p x) -> m (TT (PP p x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p x) -> m (TT (PP p x))) -> TT (PP p x) -> m (TT (PP p x))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP p x)) (PP p x, PP q x, TT (PP p x), TT (PP q x))
lr of
Left TT (PP p x)
e -> TT (PP p x)
e
Right (PP p x
p,PP q x
q,TT (PP p x)
pp,TT (PP q x)
qq) ->
let b :: PP p x
b = PP p x
p PP p x -> PP q x -> PP p x
forall s a. Snoc s s a a => s -> a -> s
`snoc` PP q x
q
in POpts -> Val (PP p x) -> String -> [Tree PE] -> TT (PP p x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP p x -> Val (PP p x)
forall a. a -> Val a
Val PP p x
b) (POpts -> String -> PP p x -> String -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 PP p x
b String
"p=" PP p x
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> PP q x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" PP q x
q) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp, TT (PP q x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q x)
qq]
data Uncons deriving Int -> Uncons -> ShowS
[Uncons] -> ShowS
Uncons -> String
(Int -> Uncons -> ShowS)
-> (Uncons -> String) -> ([Uncons] -> ShowS) -> Show Uncons
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Uncons] -> ShowS
$cshowList :: [Uncons] -> ShowS
show :: Uncons -> String
$cshow :: Uncons -> String
showsPrec :: Int -> Uncons -> ShowS
$cshowsPrec :: Int -> Uncons -> ShowS
Show
instance ( Show (ConsT s)
, Show s
, Cons s s (ConsT s) (ConsT s)
) => P Uncons s where
type PP Uncons s = Maybe (ConsT s,s)
eval :: proxy Uncons -> POpts -> s -> m (TT (PP Uncons s))
eval proxy Uncons
_ POpts
opts s
as =
let msg0 :: String
msg0 = String
"Uncons"
b :: Maybe (ConsT s, s)
b = s
as s
-> Getting (First (ConsT s, s)) s (ConsT s, s)
-> Maybe (ConsT s, s)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First (ConsT s, s)) s (ConsT s, s)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons
in TT (Maybe (ConsT s, s)) -> m (TT (Maybe (ConsT s, s)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe (ConsT s, s)) -> m (TT (Maybe (ConsT s, s))))
-> TT (Maybe (ConsT s, s)) -> m (TT (Maybe (ConsT s, s)))
forall a b. (a -> b) -> a -> b
$ POpts
-> Val (Maybe (ConsT s, s))
-> String
-> [Tree PE]
-> TT (Maybe (ConsT s, s))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe (ConsT s, s) -> Val (Maybe (ConsT s, s))
forall a. a -> Val a
Val Maybe (ConsT s, s)
b) (POpts -> String -> Maybe (ConsT s, s) -> s -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 Maybe (ConsT s, s)
b s
as) []
data Unsnoc deriving Int -> Unsnoc -> ShowS
[Unsnoc] -> ShowS
Unsnoc -> String
(Int -> Unsnoc -> ShowS)
-> (Unsnoc -> String) -> ([Unsnoc] -> ShowS) -> Show Unsnoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unsnoc] -> ShowS
$cshowList :: [Unsnoc] -> ShowS
show :: Unsnoc -> String
$cshow :: Unsnoc -> String
showsPrec :: Int -> Unsnoc -> ShowS
$cshowsPrec :: Int -> Unsnoc -> ShowS
Show
instance ( Show (ConsT s)
, Show s
, Snoc s s (ConsT s) (ConsT s)
) => P Unsnoc s where
type PP Unsnoc s = Maybe (s,ConsT s)
eval :: proxy Unsnoc -> POpts -> s -> m (TT (PP Unsnoc s))
eval proxy Unsnoc
_ POpts
opts s
as =
let msg0 :: String
msg0 = String
"Unsnoc"
b :: Maybe (s, ConsT s)
b = s
as s
-> Getting (First (s, ConsT s)) s (s, ConsT s)
-> Maybe (s, ConsT s)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First (s, ConsT s)) s (s, ConsT s)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc
in TT (Maybe (s, ConsT s)) -> m (TT (Maybe (s, ConsT s)))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Maybe (s, ConsT s)) -> m (TT (Maybe (s, ConsT s))))
-> TT (Maybe (s, ConsT s)) -> m (TT (Maybe (s, ConsT s)))
forall a b. (a -> b) -> a -> b
$ POpts
-> Val (Maybe (s, ConsT s))
-> String
-> [Tree PE]
-> TT (Maybe (s, ConsT s))
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Maybe (s, ConsT s) -> Val (Maybe (s, ConsT s))
forall a. a -> Val a
Val Maybe (s, ConsT s)
b) (POpts -> String -> Maybe (s, ConsT s) -> s -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 Maybe (s, ConsT s)
b s
as) []
data Rotate n p deriving Int -> Rotate n p -> ShowS
[Rotate n p] -> ShowS
Rotate n p -> String
(Int -> Rotate n p -> ShowS)
-> (Rotate n p -> String)
-> ([Rotate n p] -> ShowS)
-> Show (Rotate n p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k) k (p :: k). Int -> Rotate n p -> ShowS
forall k (n :: k) k (p :: k). [Rotate n p] -> ShowS
forall k (n :: k) k (p :: k). Rotate n p -> String
showList :: [Rotate n p] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k). [Rotate n p] -> ShowS
show :: Rotate n p -> String
$cshow :: forall k (n :: k) k (p :: k). Rotate n p -> String
showsPrec :: Int -> Rotate n p -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k). Int -> Rotate n p -> ShowS
Show
type RotateT n p = SplitAt (n `Mod` Length p) p >> Swap >> Fst <> Snd
instance P (RotateT n p) x => P (Rotate n p) x where
type PP (Rotate n p) x = PP (RotateT n p) x
eval :: proxy (Rotate n p) -> POpts -> x -> m (TT (PP (Rotate n p) x))
eval proxy (Rotate n p)
_ = Proxy (RotateT n p) -> POpts -> x -> m (TT (PP (RotateT n 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 (RotateT n p)
forall k (t :: k). Proxy t
Proxy @(RotateT n p))
data Partition p q deriving Int -> Partition p q -> ShowS
[Partition p q] -> ShowS
Partition p q -> String
(Int -> Partition p q -> ShowS)
-> (Partition p q -> String)
-> ([Partition p q] -> ShowS)
-> Show (Partition p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Partition p q -> ShowS
forall k (p :: k) k (q :: k). [Partition p q] -> ShowS
forall k (p :: k) k (q :: k). Partition p q -> String
showList :: [Partition p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Partition p q] -> ShowS
show :: Partition p q -> String
$cshow :: forall k (p :: k) k (q :: k). Partition p q -> String
showsPrec :: Int -> Partition p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Partition p q -> ShowS
Show
instance ( P p x
, Show x
, PP q a ~ [x]
, PP p x ~ Bool
, P q a
) => P (Partition p q) a where
type PP (Partition p q) a = (PP q a, PP q a)
eval :: proxy (Partition p q)
-> POpts -> a -> m (TT (PP (Partition p q) a))
eval proxy (Partition p q)
_ POpts
opts a
a' = do
let msg0 :: String
msg0 = String
"Partition"
TT [x]
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
a'
case Inline
-> POpts
-> String
-> TT [x]
-> [Tree PE]
-> Either (TT ([x], [x])) [x]
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT [x]
qq [] of
Left TT ([x], [x])
e -> TT ([x], [x]) -> m (TT ([x], [x]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT ([x], [x])
e
Right [x]
q ->
case POpts -> String -> [x] -> [Tree PE] -> Either (TT ([x], [x])) [x]
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) [a]
chkSize POpts
opts String
msg0 [x]
q [TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq] of
Left TT ([x], [x])
e -> TT ([x], [x]) -> m (TT ([x], [x]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT ([x], [x])
e
Right [x]
_ -> do
[((Int, x), TT Bool)]
ts <- (Int -> x -> m ((Int, x), TT Bool))
-> [Int] -> [x] -> m [((Int, x), TT Bool)]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i x
a -> ((Int
i, x
a),) (TT Bool -> ((Int, x), TT Bool))
-> m (TT Bool) -> m ((Int, x), TT Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
POpts -> a -> m (TT (PP p a))
evalBoolHide @p POpts
opts x
a) [Int
0::Int ..] [x]
q
TT ([x], [x]) -> m (TT ([x], [x]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT ([x], [x]) -> m (TT ([x], [x])))
-> TT ([x], [x]) -> m (TT ([x], [x]))
forall a b. (a -> b) -> a -> b
$ case POpts
-> String
-> [((Int, x), TT Bool)]
-> Either (TT ([x], [x])) [(Bool, (Int, x), TT Bool)]
forall x a w.
Show x =>
POpts
-> String
-> [((Int, x), TT a)]
-> Either (TT w) [(a, (Int, x), TT a)]
splitAndAlign POpts
opts String
msg0 [((Int, x), TT Bool)]
ts of
Left TT ([x], [x])
e -> TT ([x], [x])
e
Right [(Bool, (Int, x), TT Bool)]
abcs ->
let itts :: [((Int, x), TT Bool)]
itts = ((Bool, (Int, x), TT Bool) -> ((Int, x), TT Bool))
-> [(Bool, (Int, x), TT Bool)] -> [((Int, x), TT Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting (Int, x) (Bool, (Int, x), TT Bool) (Int, x)
-> (Bool, (Int, x), TT Bool) -> (Int, x)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (Int, x) (Bool, (Int, x), TT Bool) (Int, x)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Bool, (Int, x), TT Bool) -> (Int, x))
-> ((Bool, (Int, x), TT Bool) -> TT Bool)
-> (Bool, (Int, x), TT Bool)
-> ((Int, x), TT Bool)
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting (TT Bool) (Bool, (Int, x), TT Bool) (TT Bool)
-> (Bool, (Int, x), TT Bool) -> TT Bool
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (TT Bool) (Bool, (Int, x), TT Bool) (TT Bool)
forall s t a b. Field3 s t a b => Lens s t a b
_3) [(Bool, (Int, x), TT Bool)]
abcs
w0 :: ([(Bool, (Int, x), TT Bool)], [(Bool, (Int, x), TT Bool)])
w0 = ((Bool, (Int, x), TT Bool) -> Bool)
-> [(Bool, (Int, x), TT Bool)]
-> ([(Bool, (Int, x), TT Bool)], [(Bool, (Int, x), TT Bool)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Getting Bool (Bool, (Int, x), TT Bool) Bool
-> (Bool, (Int, x), TT Bool) -> Bool
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting Bool (Bool, (Int, x), TT Bool) Bool
forall s t a b. Field1 s t a b => Lens s t a b
_1) [(Bool, (Int, x), TT Bool)]
abcs
zz1 :: ([x], [x])
zz1 = (((Bool, (Int, x), TT Bool) -> x)
-> [(Bool, (Int, x), TT Bool)] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map (Getting x (Bool, (Int, x), TT Bool) x
-> (Bool, (Int, x), TT Bool) -> x
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view (((Int, x) -> Const x (Int, x))
-> (Bool, (Int, x), TT Bool) -> Const x (Bool, (Int, x), TT Bool)
forall s t a b. Field2 s t a b => Lens s t a b
_2 (((Int, x) -> Const x (Int, x))
-> (Bool, (Int, x), TT Bool) -> Const x (Bool, (Int, x), TT Bool))
-> ((x -> Const x x) -> (Int, x) -> Const x (Int, x))
-> Getting x (Bool, (Int, x), TT Bool) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> Const x x) -> (Int, x) -> Const x (Int, x)
forall s t a b. Field2 s t a b => Lens s t a b
_2)) ([(Bool, (Int, x), TT Bool)] -> [x])
-> ([(Bool, (Int, x), TT Bool)] -> [x])
-> ([(Bool, (Int, x), TT Bool)], [(Bool, (Int, x), TT Bool)])
-> ([x], [x])
forall (a :: Type -> Type -> Type) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ((Bool, (Int, x), TT Bool) -> x)
-> [(Bool, (Int, x), TT Bool)] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map (Getting x (Bool, (Int, x), TT Bool) x
-> (Bool, (Int, x), TT Bool) -> x
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view (((Int, x) -> Const x (Int, x))
-> (Bool, (Int, x), TT Bool) -> Const x (Bool, (Int, x), TT Bool)
forall s t a b. Field2 s t a b => Lens s t a b
_2 (((Int, x) -> Const x (Int, x))
-> (Bool, (Int, x), TT Bool) -> Const x (Bool, (Int, x), TT Bool))
-> ((x -> Const x x) -> (Int, x) -> Const x (Int, x))
-> Getting x (Bool, (Int, x), TT Bool) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> Const x x) -> (Int, x) -> Const x (Int, x)
forall s t a b. Field2 s t a b => Lens s t a b
_2))) ([(Bool, (Int, x), TT Bool)], [(Bool, (Int, x), TT Bool)])
w0
in POpts -> Val ([x], [x]) -> String -> [Tree PE] -> TT ([x], [x])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (([x], [x]) -> Val ([x], [x])
forall a. a -> Val a
Val ([x], [x])
zz1) (POpts -> String -> ([x], [x]) -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 ([x], [x])
zz1 String
"s=" [x]
q) (TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: (((Int, x), TT Bool) -> Tree PE)
-> [((Int, x), TT Bool)] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh (TT Bool -> Tree PE)
-> (((Int, x), TT Bool) -> TT Bool)
-> ((Int, x), TT Bool)
-> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, x), TT Bool) -> TT Bool
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) [((Int, x), TT Bool)]
itts)
data Quant p deriving Int -> Quant p -> ShowS
[Quant p] -> ShowS
Quant p -> String
(Int -> Quant p -> ShowS)
-> (Quant p -> String) -> ([Quant p] -> ShowS) -> Show (Quant p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Quant p -> ShowS
forall k (p :: k). [Quant p] -> ShowS
forall k (p :: k). Quant p -> String
showList :: [Quant p] -> ShowS
$cshowList :: forall k (p :: k). [Quant p] -> ShowS
show :: Quant p -> String
$cshow :: forall k (p :: k). Quant p -> String
showsPrec :: Int -> Quant p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Quant p -> ShowS
Show
type QuantT p = Partition p Id >> '(Length Fst,Length Snd)
instance P (QuantT p) x => P (Quant p) x where
type PP (Quant p) x = PP (QuantT p) x
eval :: proxy (Quant p) -> POpts -> x -> m (TT (PP (Quant p) x))
eval proxy (Quant p)
_ = Proxy (QuantT p) -> POpts -> x -> m (TT (PP (QuantT 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 (QuantT p)
forall k (t :: k). Proxy t
Proxy @(QuantT p))
data All1 p deriving Int -> All1 p -> ShowS
[All1 p] -> ShowS
All1 p -> String
(Int -> All1 p -> ShowS)
-> (All1 p -> String) -> ([All1 p] -> ShowS) -> Show (All1 p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> All1 p -> ShowS
forall k (p :: k). [All1 p] -> ShowS
forall k (p :: k). All1 p -> String
showList :: [All1 p] -> ShowS
$cshowList :: forall k (p :: k). [All1 p] -> ShowS
show :: All1 p -> String
$cshow :: forall k (p :: k). All1 p -> String
showsPrec :: Int -> All1 p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> All1 p -> ShowS
Show
instance P (Quant p) x => P (All1 p) x where
type PP (All1 p) x = Bool
eval :: proxy (All1 p) -> POpts -> x -> m (TT (PP (All1 p) x))
eval proxy (All1 p)
_ POpts
opts
| POpts -> Bool
isVerbose POpts
opts = Proxy (Quant p >> ((Fst > 0) && (Snd == 0)))
-> POpts
-> x
-> m (TT (PP (Quant p >> ((Fst > 0) && (Snd == 0))) 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 (Quant p >> ((Fst > 0) && (Snd == 0)))
forall k (t :: k). Proxy t
Proxy @(Quant p >> Fst > 0 && Snd == 0)) POpts
opts
| Bool
otherwise = Proxy (Hide (Quant p) >> ((Fst > 0) && (Snd == 0)))
-> POpts
-> x
-> m (TT (PP (Hide (Quant p) >> ((Fst > 0) && (Snd == 0))) 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 (Hide (Quant p) >> ((Fst > 0) && (Snd == 0)))
forall k (t :: k). Proxy t
Proxy @(Hide (Quant p) >> Fst > 0 && Snd == 0)) POpts
opts
data PartitionBy t p q deriving Int -> PartitionBy t p q -> ShowS
[PartitionBy t p q] -> ShowS
PartitionBy t p q -> String
(Int -> PartitionBy t p q -> ShowS)
-> (PartitionBy t p q -> String)
-> ([PartitionBy t p q] -> ShowS)
-> Show (PartitionBy t p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k) k (q :: k).
Int -> PartitionBy t p q -> ShowS
forall k (t :: k) k (p :: k) k (q :: k).
[PartitionBy t p q] -> ShowS
forall k (t :: k) k (p :: k) k (q :: k).
PartitionBy t p q -> String
showList :: [PartitionBy t p q] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k) k (q :: k).
[PartitionBy t p q] -> ShowS
show :: PartitionBy t p q -> String
$cshow :: forall k (t :: k) k (p :: k) k (q :: k).
PartitionBy t p q -> String
showsPrec :: Int -> PartitionBy t p q -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k) k (q :: k).
Int -> PartitionBy t p q -> ShowS
Show
instance ( P p x
, Ord t
, Show x
, Show t
, PP q a ~ [x]
, PP p x ~ t
, P q a
) => P (PartitionBy t p q) a where
type PP (PartitionBy t p q) a = M.Map t (PP q a)
eval :: proxy (PartitionBy t p q)
-> POpts -> a -> m (TT (PP (PartitionBy t p q) a))
eval proxy (PartitionBy t p q)
_ POpts
opts a
a' = do
let msg0 :: String
msg0 = String
"PartitionBy"
TT [x]
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
a'
case Inline
-> POpts
-> String
-> TT [x]
-> [Tree PE]
-> Either (TT (Map t [x])) [x]
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT [x]
qq [] of
Left TT (Map t [x])
e -> TT (Map t [x]) -> m (TT (Map t [x]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Map t [x])
e
Right [x]
q ->
case POpts -> String -> [x] -> [Tree PE] -> Either (TT (Map t [x])) [x]
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) [a]
chkSize POpts
opts String
msg0 [x]
q [TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq] of
Left TT (Map t [x])
e -> TT (Map t [x]) -> m (TT (Map t [x]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (Map t [x])
e
Right [x]
_ -> do
[((Int, x), TT t)]
ts <- (Int -> x -> m ((Int, x), TT t))
-> [Int] -> [x] -> m [((Int, x), TT t)]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i x
a -> ((Int
i, x
a),) (TT t -> ((Int, x), TT t)) -> m (TT t) -> m ((Int, x), TT t)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p a) =>
POpts -> a -> m (TT (PP p a))
evalHide @p POpts
opts x
a) [Int
0::Int ..] [x]
q
TT (Map t [x]) -> m (TT (Map t [x]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (Map t [x]) -> m (TT (Map t [x])))
-> TT (Map t [x]) -> m (TT (Map t [x]))
forall a b. (a -> b) -> a -> b
$ case POpts
-> String
-> [((Int, x), TT t)]
-> Either (TT (Map t [x])) [(t, (Int, x), TT t)]
forall x a w.
Show x =>
POpts
-> String
-> [((Int, x), TT a)]
-> Either (TT w) [(a, (Int, x), TT a)]
splitAndAlign POpts
opts String
msg0 [((Int, x), TT t)]
ts of
Left TT (Map t [x])
e -> TT (Map t [x])
e
Right [(t, (Int, x), TT t)]
abcs ->
let kvs :: [(t, [x])]
kvs = ((t, (Int, x), TT t) -> (t, [x]))
-> [(t, (Int, x), TT t)] -> [(t, [x])]
forall a b. (a -> b) -> [a] -> [b]
map (Getting t (t, (Int, x), TT t) t -> (t, (Int, x), TT t) -> t
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting t (t, (Int, x), TT t) t
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((t, (Int, x), TT t) -> t)
-> ((t, (Int, x), TT t) -> [x]) -> (t, (Int, x), TT t) -> (t, [x])
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ((x -> [x] -> [x]
forall a. a -> [a] -> [a]
:[]) (x -> [x])
-> ((t, (Int, x), TT t) -> x) -> (t, (Int, x), TT t) -> [x]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting x (t, (Int, x), TT t) x -> (t, (Int, x), TT t) -> x
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view (((Int, x) -> Const x (Int, x))
-> (t, (Int, x), TT t) -> Const x (t, (Int, x), TT t)
forall s t a b. Field2 s t a b => Lens s t a b
_2 (((Int, x) -> Const x (Int, x))
-> (t, (Int, x), TT t) -> Const x (t, (Int, x), TT t))
-> ((x -> Const x x) -> (Int, x) -> Const x (Int, x))
-> Getting x (t, (Int, x), TT t) x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> Const x x) -> (Int, x) -> Const x (Int, x)
forall s t a b. Field2 s t a b => Lens s t a b
_2))) [(t, (Int, x), TT t)]
abcs
itts :: [((Int, x), TT t)]
itts = ((t, (Int, x), TT t) -> ((Int, x), TT t))
-> [(t, (Int, x), TT t)] -> [((Int, x), TT t)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting (Int, x) (t, (Int, x), TT t) (Int, x)
-> (t, (Int, x), TT t) -> (Int, x)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (Int, x) (t, (Int, x), TT t) (Int, x)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((t, (Int, x), TT t) -> (Int, x))
-> ((t, (Int, x), TT t) -> TT t)
-> (t, (Int, x), TT t)
-> ((Int, x), TT t)
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting (TT t) (t, (Int, x), TT t) (TT t)
-> (t, (Int, x), TT t) -> TT t
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (TT t) (t, (Int, x), TT t) (TT t)
forall s t a b. Field3 s t a b => Lens s t a b
_3) [(t, (Int, x), TT t)]
abcs
ret :: Map t [x]
ret = ([x] -> [x] -> [x]) -> [(t, [x])] -> Map t [x]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [x] -> [x] -> [x]
forall a. [a] -> [a] -> [a]
(++) [(t, [x])]
kvs
in POpts -> Val (Map t [x]) -> String -> [Tree PE] -> TT (Map t [x])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Map t [x] -> Val (Map t [x])
forall a. a -> Val a
Val Map t [x]
ret) (POpts -> String -> Map t [x] -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 Map t [x]
ret String
"s=" [x]
q ) (TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: (((Int, x), TT t) -> Tree PE) -> [((Int, x), TT t)] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT t -> Tree PE
forall a. TT a -> Tree PE
hh (TT t -> Tree PE)
-> (((Int, x), TT t) -> TT t) -> ((Int, x), TT t) -> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, x), TT t) -> TT t
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) [((Int, x), TT t)]
itts)
data GroupBy p q deriving Int -> GroupBy p q -> ShowS
[GroupBy p q] -> ShowS
GroupBy p q -> String
(Int -> GroupBy p q -> ShowS)
-> (GroupBy p q -> String)
-> ([GroupBy p q] -> ShowS)
-> Show (GroupBy p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> GroupBy p q -> ShowS
forall k (p :: k) k (q :: k). [GroupBy p q] -> ShowS
forall k (p :: k) k (q :: k). GroupBy p q -> String
showList :: [GroupBy p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [GroupBy p q] -> ShowS
show :: GroupBy p q -> String
$cshow :: forall k (p :: k) k (q :: k). GroupBy p q -> String
showsPrec :: Int -> GroupBy p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> GroupBy p q -> ShowS
Show
instance ( Show x
, PP q a ~ [x]
, PP p (x,x) ~ Bool
, P p (x,x)
, P q a
) => P (GroupBy p q) a where
type PP (GroupBy p q) a = [PP q a]
eval :: proxy (GroupBy p q) -> POpts -> a -> m (TT (PP (GroupBy p q) a))
eval proxy (GroupBy p q)
_ POpts
opts a
a' = do
let msg0 :: String
msg0 = String
"GroupBy"
TT [x]
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
a'
case Inline
-> POpts -> String -> TT [x] -> [Tree PE] -> Either (TT [[x]]) [x]
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT [x]
qq [] of
Left TT [[x]]
e -> TT [[x]] -> m (TT [[x]])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [[x]]
e
Right [x]
q ->
case POpts -> String -> [x] -> [Tree PE] -> Either (TT [[x]]) [x]
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) [a]
chkSize POpts
opts String
msg0 [x]
q [TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq] of
Left TT [[x]]
e -> TT [[x]] -> m (TT [[x]])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [[x]]
e
Right [x]
_ ->
case [x]
q of
[] -> TT [[x]] -> m (TT [[x]])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [[x]] -> m (TT [[x]])) -> TT [[x]] -> m (TT [[x]])
forall a b. (a -> b) -> a -> b
$ POpts -> Val [[x]] -> String -> [Tree PE] -> TT [[x]]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([[x]] -> Val [[x]]
forall a. a -> Val a
Val []) (POpts -> String -> [x] -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [x]
q String
"s=" [x]
q) [TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq]
[x
_] -> let ret :: [[x]]
ret = [[x]
q]
in TT [[x]] -> m (TT [[x]])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [[x]] -> m (TT [[x]])) -> TT [[x]] -> m (TT [[x]])
forall a b. (a -> b) -> a -> b
$ POpts -> Val [[x]] -> String -> [Tree PE] -> TT [[x]]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([[x]] -> Val [[x]]
forall a. a -> Val a
Val [[x]]
ret) (POpts -> String -> [[x]] -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [[x]]
ret String
"s=" [x]
q) [TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq]
x
x:[x]
xs -> do
[((Int, x), TT Bool)]
ts <- (Int -> (x, x) -> m ((Int, x), TT Bool))
-> [Int] -> [(x, x)] -> m [((Int, x), TT Bool)]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i (x
a,x
b) -> ((Int
i, x
b),) (TT Bool -> ((Int, x), TT Bool))
-> m (TT Bool) -> m ((Int, x), TT Bool)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> POpts -> (x, x) -> m (TT (PP p (x, x)))
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
POpts -> a -> m (TT (PP p a))
evalBoolHide @p POpts
opts (x
a,x
b)) [Int
0::Int ..] ([x] -> [x] -> [(x, x)]
forall a b. [a] -> [b] -> [(a, b)]
zip (x
xx -> [x] -> [x]
forall a. a -> [a] -> [a]
:[x]
xs) [x]
xs)
TT [[x]] -> m (TT [[x]])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [[x]] -> m (TT [[x]])) -> TT [[x]] -> m (TT [[x]])
forall a b. (a -> b) -> a -> b
$ case POpts
-> String
-> [((Int, x), TT Bool)]
-> Either (TT [[x]]) [(Bool, (Int, x), TT Bool)]
forall x a w.
Show x =>
POpts
-> String
-> [((Int, x), TT a)]
-> Either (TT w) [(a, (Int, x), TT a)]
splitAndAlign POpts
opts String
msg0 [((Int, x), TT Bool)]
ts of
Left TT [[x]]
e -> TT [[x]]
e
Right [(Bool, (Int, x), TT Bool)]
abcs ->
let ret :: [[x]]
ret = x -> [(Bool, (Int, x), TT Bool)] -> [[x]]
forall x. x -> [(Bool, (Int, x), TT Bool)] -> [[x]]
gp1 x
x [(Bool, (Int, x), TT Bool)]
abcs
itts :: [((Int, x), TT Bool)]
itts = ((Bool, (Int, x), TT Bool) -> ((Int, x), TT Bool))
-> [(Bool, (Int, x), TT Bool)] -> [((Int, x), TT Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting (Int, x) (Bool, (Int, x), TT Bool) (Int, x)
-> (Bool, (Int, x), TT Bool) -> (Int, x)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (Int, x) (Bool, (Int, x), TT Bool) (Int, x)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Bool, (Int, x), TT Bool) -> (Int, x))
-> ((Bool, (Int, x), TT Bool) -> TT Bool)
-> (Bool, (Int, x), TT Bool)
-> ((Int, x), TT Bool)
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting (TT Bool) (Bool, (Int, x), TT Bool) (TT Bool)
-> (Bool, (Int, x), TT Bool) -> TT Bool
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (TT Bool) (Bool, (Int, x), TT Bool) (TT Bool)
forall s t a b. Field3 s t a b => Lens s t a b
_3) [(Bool, (Int, x), TT Bool)]
abcs
in POpts -> Val [[x]] -> String -> [Tree PE] -> TT [[x]]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([[x]] -> Val [[x]]
forall a. a -> Val a
Val [[x]]
ret) (POpts -> String -> [[x]] -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [[x]]
ret String
"s=" [x]
q ) (TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: (((Int, x), TT Bool) -> Tree PE)
-> [((Int, x), TT Bool)] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh (TT Bool -> Tree PE)
-> (((Int, x), TT Bool) -> TT Bool)
-> ((Int, x), TT Bool)
-> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, x), TT Bool) -> TT Bool
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) [((Int, x), TT Bool)]
itts)
data GroupCntStable deriving Int -> GroupCntStable -> ShowS
[GroupCntStable] -> ShowS
GroupCntStable -> String
(Int -> GroupCntStable -> ShowS)
-> (GroupCntStable -> String)
-> ([GroupCntStable] -> ShowS)
-> Show GroupCntStable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupCntStable] -> ShowS
$cshowList :: [GroupCntStable] -> ShowS
show :: GroupCntStable -> String
$cshow :: GroupCntStable -> String
showsPrec :: Int -> GroupCntStable -> ShowS
$cshowsPrec :: Int -> GroupCntStable -> ShowS
Show
instance ( a ~ [x]
, Ord x
) => P GroupCntStable a where
type PP GroupCntStable a = [(ExtractAFromList a, Int)]
eval :: proxy GroupCntStable -> POpts -> a -> m (TT (PP GroupCntStable a))
eval proxy GroupCntStable
_ POpts
opts a
zs =
let msg0 :: String
msg0 = String
"GroupCntStable"
xs :: [(x, Int)]
xs = (NonEmpty x -> (x, Int)) -> [NonEmpty x] -> [(x, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (NonEmpty x -> x
forall a. NonEmpty a -> a
NE.head (NonEmpty x -> x) -> (NonEmpty x -> Int) -> NonEmpty x -> (x, Int)
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& NonEmpty x -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length) ([NonEmpty x] -> [(x, Int)]) -> [NonEmpty x] -> [(x, Int)]
forall a b. (a -> b) -> a -> b
$ [x] -> [NonEmpty x]
forall (f :: Type -> Type) a.
(Foldable f, Eq a) =>
f a -> [NonEmpty a]
NE.group ([x] -> [NonEmpty x]) -> [x] -> [NonEmpty x]
forall a b. (a -> b) -> a -> b
$ (x -> Int) -> [x] -> [x]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Map x Int
ys Map x Int -> x -> Int
forall k a. Ord k => Map k a -> k -> a
M.!) a
[x]
zs
ys :: Map x Int
ys = (Int -> Int -> Int) -> [(x, Int)] -> Map x Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith ((Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
forall a b. a -> b -> a
const) ([(x, Int)] -> Map x Int) -> [(x, Int)] -> Map x Int
forall a b. (a -> b) -> a -> b
$ [x] -> [Int] -> [(x, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip a
[x]
zs [Int
0::Int ..]
in TT [(x, Int)] -> m (TT [(x, Int)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(x, Int)] -> m (TT [(x, Int)]))
-> TT [(x, Int)] -> m (TT [(x, Int)])
forall a b. (a -> b) -> a -> b
$ POpts -> Val [(x, Int)] -> String -> [Tree PE] -> TT [(x, Int)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(x, Int)] -> Val [(x, Int)]
forall a. a -> Val a
Val [(x, Int)]
xs) String
msg0 []
data Group deriving Int -> Group -> ShowS
[Group] -> ShowS
Group -> String
(Int -> Group -> ShowS)
-> (Group -> String) -> ([Group] -> ShowS) -> Show Group
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Group] -> ShowS
$cshowList :: [Group] -> ShowS
show :: Group -> String
$cshow :: Group -> String
showsPrec :: Int -> Group -> ShowS
$cshowsPrec :: Int -> Group -> ShowS
Show
type GroupT = GroupBy (Fst == Snd) Id
instance P GroupT x => P Group x where
type PP Group x = PP GroupT x
eval :: proxy Group -> POpts -> x -> m (TT (PP Group x))
eval proxy Group
_ = Proxy GroupT -> POpts -> x -> m (TT (PP GroupT 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 GroupT
forall k (t :: k). Proxy t
Proxy @GroupT)
data GroupCnt deriving Int -> GroupCnt -> ShowS
[GroupCnt] -> ShowS
GroupCnt -> String
(Int -> GroupCnt -> ShowS)
-> (GroupCnt -> String) -> ([GroupCnt] -> ShowS) -> Show GroupCnt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupCnt] -> ShowS
$cshowList :: [GroupCnt] -> ShowS
show :: GroupCnt -> String
$cshow :: GroupCnt -> String
showsPrec :: Int -> GroupCnt -> ShowS
$cshowsPrec :: Int -> GroupCnt -> ShowS
Show
type GroupCntT = Group >> Map '(Head,Len)
instance P GroupCntT x => P GroupCnt x where
type PP GroupCnt x = PP GroupCntT x
eval :: proxy GroupCnt -> POpts -> x -> m (TT (PP GroupCnt x))
eval proxy GroupCnt
_ = Proxy GroupCntT -> POpts -> x -> m (TT (PP GroupCntT 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 GroupCntT
forall k (t :: k). Proxy t
Proxy @GroupCntT)
gp1 :: x -> [(Bool, (Int, x), TT Bool)] -> [[x]]
gp1 :: x -> [(Bool, (Int, x), TT Bool)] -> [[x]]
gp1 x
b = [x] -> [(Bool, (Int, x), TT Bool)] -> [[x]]
forall a a c. [a] -> [(Bool, (a, a), c)] -> [[a]]
go [x
b]
where
go :: [a] -> [(Bool, (a, a), c)] -> [[a]]
go [a]
ret =
\case
[] -> [[a]
ret]
(Bool
tf, (a
_, a
a), c
_):[(Bool, (a, a), c)]
as -> if Bool
tf then [a] -> [(Bool, (a, a), c)] -> [[a]]
go ([a]
ret [a] -> [a] -> [a]
forall a. Semigroup a => a -> a -> a
<> [a
a]) [(Bool, (a, a), c)]
as
else [a]
ret [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [(Bool, (a, a), c)] -> [[a]]
go [a
a] [(Bool, (a, a), c)]
as
data Filter p q deriving Int -> Filter p q -> ShowS
[Filter p q] -> ShowS
Filter p q -> String
(Int -> Filter p q -> ShowS)
-> (Filter p q -> String)
-> ([Filter p q] -> ShowS)
-> Show (Filter p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Filter p q -> ShowS
forall k (p :: k) k (q :: k). [Filter p q] -> ShowS
forall k (p :: k) k (q :: k). Filter p q -> String
showList :: [Filter p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Filter p q] -> ShowS
show :: Filter p q -> String
$cshow :: forall k (p :: k) k (q :: k). Filter p q -> String
showsPrec :: Int -> Filter p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Filter p q -> ShowS
Show
type FilterT p q = Partition p q >> Fst
instance P (FilterT p q) x => P (Filter p q) x where
type PP (Filter p q) x = PP (FilterT p q) x
eval :: proxy (Filter p q) -> POpts -> x -> m (TT (PP (Filter p q) x))
eval proxy (Filter p q)
_ = Proxy (FilterT p q) -> POpts -> x -> m (TT (PP (FilterT 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 (FilterT p q)
forall k (t :: k). Proxy t
Proxy @(FilterT p q))
data Break p q deriving Int -> Break p q -> ShowS
[Break p q] -> ShowS
Break p q -> String
(Int -> Break p q -> ShowS)
-> (Break p q -> String)
-> ([Break p q] -> ShowS)
-> Show (Break p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Break p q -> ShowS
forall k (p :: k) k (q :: k). [Break p q] -> ShowS
forall k (p :: k) k (q :: k). Break p q -> String
showList :: [Break p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Break p q] -> ShowS
show :: Break p q -> String
$cshow :: forall k (p :: k) k (q :: k). Break p q -> String
showsPrec :: Int -> Break p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Break p q -> ShowS
Show
instance ( P p x
, PP q a ~ [x]
, PP p x ~ Bool
, P q a
) => P (Break p q) a where
type PP (Break p q) a = (PP q a, PP q a)
eval :: proxy (Break p q) -> POpts -> a -> m (TT (PP (Break p q) a))
eval proxy (Break p q)
_ POpts
opts a
a' = do
let msg0 :: String
msg0 = String
"Break"
TT [x]
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
a'
case Inline
-> POpts
-> String
-> TT [x]
-> [Tree PE]
-> Either (TT ([x], [x])) [x]
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT [x]
qq [] of
Left TT ([x], [x])
e -> TT ([x], [x]) -> m (TT ([x], [x]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT ([x], [x])
e
Right [x]
q ->
case POpts -> String -> [x] -> [Tree PE] -> Either (TT ([x], [x])) [x]
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) [a]
chkSize POpts
opts String
msg0 [x]
q [TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq] of
Left TT ([x], [x])
e -> TT ([x], [x]) -> m (TT ([x], [x]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT ([x], [x])
e
Right [x]
_ -> do
let ff :: [(Int, x)]
-> Seq ((Int, x), TT Bool)
-> m (Seq ((Int, x), TT Bool), [x], Maybe ((Int, x), TT Bool))
ff [] Seq ((Int, x), TT Bool)
zs = (Seq ((Int, x), TT Bool), [x], Maybe ((Int, x), TT Bool))
-> m (Seq ((Int, x), TT Bool), [x], Maybe ((Int, x), TT Bool))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Seq ((Int, x), TT Bool)
zs, [], Maybe ((Int, x), TT Bool)
forall a. Maybe a
Nothing)
ff ((Int
i,x
a):[(Int, x)]
ias) Seq ((Int, x), TT Bool)
zs = do
TT Bool
pp <- POpts -> x -> m (TT (PP p x))
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
POpts -> a -> m (TT (PP p a))
evalBoolHide @p POpts
opts x
a
let v :: ((Int, x), TT Bool)
v = ((Int
i,x
a), TT Bool
pp)
case Inline
-> POpts -> String -> TT Bool -> [Tree PE] -> Either (TT Any) 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 [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq] of
Right Bool
False -> [(Int, x)]
-> Seq ((Int, x), TT Bool)
-> m (Seq ((Int, x), TT Bool), [x], Maybe ((Int, x), TT Bool))
ff [(Int, x)]
ias (Seq ((Int, x), TT Bool)
zs Seq ((Int, x), TT Bool)
-> ((Int, x), TT Bool) -> Seq ((Int, x), TT Bool)
forall a. Seq a -> a -> Seq a
Seq.|> ((Int, x), TT Bool)
v)
Right Bool
True -> (Seq ((Int, x), TT Bool), [x], Maybe ((Int, x), TT Bool))
-> m (Seq ((Int, x), TT Bool), [x], Maybe ((Int, x), TT Bool))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Seq ((Int, x), TT Bool)
zs,((Int, x) -> x) -> [(Int, x)] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map (Int, x) -> x
forall a b. (a, b) -> b
snd [(Int, x)]
ias,((Int, x), TT Bool) -> Maybe ((Int, x), TT Bool)
forall a. a -> Maybe a
Just ((Int, x), TT Bool)
v)
Left TT Any
_ -> (Seq ((Int, x), TT Bool), [x], Maybe ((Int, x), TT Bool))
-> m (Seq ((Int, x), TT Bool), [x], Maybe ((Int, x), TT Bool))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Seq ((Int, x), TT Bool)
zs,((Int, x) -> x) -> [(Int, x)] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map (Int, x) -> x
forall a b. (a, b) -> b
snd [(Int, x)]
ias,((Int, x), TT Bool) -> Maybe ((Int, x), TT Bool)
forall a. a -> Maybe a
Just ((Int, x), TT Bool)
v)
(Seq ((Int, x), TT Bool)
ialls,[x]
rhs,Maybe ((Int, x), TT Bool)
mpivot) <- [(Int, x)]
-> Seq ((Int, x), TT Bool)
-> m (Seq ((Int, x), TT Bool), [x], Maybe ((Int, x), TT Bool))
ff ([x] -> [(Int, x)]
forall i (f :: Type -> Type) a.
FoldableWithIndex i f =>
f a -> [(i, a)]
itoList [x]
q) Seq ((Int, x), TT Bool)
forall a. Seq a
Seq.empty
TT ([x], [x]) -> m (TT ([x], [x]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT ([x], [x]) -> m (TT ([x], [x])))
-> TT ([x], [x]) -> m (TT ([x], [x]))
forall a b. (a -> b) -> a -> b
$ case Maybe ((Int, x), TT Bool)
mpivot of
Maybe ((Int, x), TT Bool)
Nothing ->
POpts -> Val ([x], [x]) -> String -> [Tree PE] -> TT ([x], [x])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (([x], [x]) -> Val ([x], [x])
forall a. a -> Val a
Val ((((Int, x), TT Bool) -> x) -> [((Int, x), TT Bool)] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, x) -> x
forall a b. (a, b) -> b
snd ((Int, x) -> x)
-> (((Int, x), TT Bool) -> (Int, x)) -> ((Int, x), TT Bool) -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, x), TT Bool) -> (Int, x)
forall a b. (a, b) -> a
fst) (Seq ((Int, x), TT Bool) -> [((Int, x), TT Bool)]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList Seq ((Int, x), TT Bool)
ialls), [x]
rhs))
(String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" cnt=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Int) -> String
forall a. Show a => a -> String
show (Seq ((Int, x), TT Bool) -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length Seq ((Int, x), TT Bool)
ialls, [x] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [x]
rhs))
((((Int, x), TT Bool) -> Tree PE)
-> [((Int, x), TT Bool)] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh (TT Bool -> Tree PE)
-> (((Int, x), TT Bool) -> TT Bool)
-> ((Int, x), TT Bool)
-> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, x), TT Bool) -> TT Bool
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) (Seq ((Int, x), TT Bool) -> [((Int, x), TT Bool)]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList Seq ((Int, x), TT Bool)
ialls))
Just iatt :: ((Int, x), TT Bool)
iatt@((Int, x)
ia, TT Bool
tt) ->
case Inline
-> POpts
-> String
-> TT Bool
-> [Tree PE]
-> Either (TT ([x], [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
" predicate failed") TT Bool
tt (TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: (((Int, x), TT Bool) -> Tree PE)
-> [((Int, x), TT Bool)] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh (TT Bool -> Tree PE)
-> (((Int, x), TT Bool) -> TT Bool)
-> ((Int, x), TT Bool)
-> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, x), TT Bool) -> TT Bool
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) (Seq ((Int, x), TT Bool) -> [((Int, x), TT Bool)]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Seq ((Int, x), TT Bool)
ialls Seq ((Int, x), TT Bool)
-> ((Int, x), TT Bool) -> Seq ((Int, x), TT Bool)
forall a. Seq a -> a -> Seq a
Seq.|> ((Int, x), TT Bool)
iatt))) of
Right Bool
True ->
POpts -> Val ([x], [x]) -> String -> [Tree PE] -> TT ([x], [x])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (([x], [x]) -> Val ([x], [x])
forall a. a -> Val a
Val ((((Int, x), TT Bool) -> x) -> [((Int, x), TT Bool)] -> [x]
forall a b. (a -> b) -> [a] -> [b]
map ((Int, x) -> x
forall a b. (a, b) -> b
snd ((Int, x) -> x)
-> (((Int, x), TT Bool) -> (Int, x)) -> ((Int, x), TT Bool) -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, x), TT Bool) -> (Int, x)
forall a b. (a, b) -> a
fst) (Seq ((Int, x), TT Bool) -> [((Int, x), TT Bool)]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList Seq ((Int, x), TT Bool)
ialls), (Int, x) -> x
forall a b. (a, b) -> b
snd (Int, x)
ia x -> [x] -> [x]
forall a. a -> [a] -> [a]
: [x]
rhs))
(String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" cnt=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Int, Int) -> String
forall a. Show a => a -> String
show (Seq ((Int, x), TT Bool) -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length Seq ((Int, x), TT Bool)
ialls, Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+[x] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [x]
rhs))
(TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh TT Bool
tt Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: (((Int, x), TT Bool) -> Tree PE)
-> [((Int, x), TT Bool)] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT Bool -> Tree PE
forall a. TT a -> Tree PE
hh (TT Bool -> Tree PE)
-> (((Int, x), TT Bool) -> TT Bool)
-> ((Int, x), TT Bool)
-> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, x), TT Bool) -> TT Bool
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) (Seq ((Int, x), TT Bool) -> [((Int, x), TT Bool)]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Seq ((Int, x), TT Bool)
ialls Seq ((Int, x), TT Bool)
-> ((Int, x), TT Bool) -> Seq ((Int, x), TT Bool)
forall a. Seq a -> a -> Seq a
Seq.|> ((Int, x), TT Bool)
iatt)))
Right Bool
False -> String -> TT ([x], [x])
forall x. HasCallStack => String -> x
errorInProgram String
"Break"
Left TT ([x], [x])
e -> TT ([x], [x])
e
data Span p q deriving Int -> Span p q -> ShowS
[Span p q] -> ShowS
Span p q -> String
(Int -> Span p q -> ShowS)
-> (Span p q -> String) -> ([Span p q] -> ShowS) -> Show (Span p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Span p q -> ShowS
forall k (p :: k) k (q :: k). [Span p q] -> ShowS
forall k (p :: k) k (q :: k). Span p q -> String
showList :: [Span p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Span p q] -> ShowS
show :: Span p q -> String
$cshow :: forall k (p :: k) k (q :: k). Span p q -> String
showsPrec :: Int -> Span p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Span p q -> ShowS
Show
type SpanT p q = Break (Not p) q
instance P (SpanT p q) x => P (Span p q) x where
type PP (Span p q) x = PP (SpanT p q) x
eval :: proxy (Span p q) -> POpts -> x -> m (TT (PP (Span p q) x))
eval proxy (Span p q)
_ = Proxy (SpanT p q) -> POpts -> x -> m (TT (PP (SpanT 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 (SpanT p q)
forall k (t :: k). Proxy t
Proxy @(SpanT p q))
data Intercalate p q deriving Int -> Intercalate p q -> ShowS
[Intercalate p q] -> ShowS
Intercalate p q -> String
(Int -> Intercalate p q -> ShowS)
-> (Intercalate p q -> String)
-> ([Intercalate p q] -> ShowS)
-> Show (Intercalate p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Intercalate p q -> ShowS
forall k (p :: k) k (q :: k). [Intercalate p q] -> ShowS
forall k (p :: k) k (q :: k). Intercalate p q -> String
showList :: [Intercalate p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Intercalate p q] -> ShowS
show :: Intercalate p q -> String
$cshow :: forall k (p :: k) k (q :: k). Intercalate p q -> String
showsPrec :: Int -> Intercalate p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Intercalate p q -> ShowS
Show
instance ( PP p x ~ [a]
, PP q x ~ PP p x
, P p x
, P q x
, Show a
) => P (Intercalate p q) x where
type PP (Intercalate p q) x = PP p x
eval :: proxy (Intercalate p q)
-> POpts -> x -> m (TT (PP (Intercalate p q) x))
eval proxy (Intercalate p q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Intercalate"
Either (TT [a]) ([a], [a], TT [a], TT [a])
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT [a]) (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 [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 Either (TT [a]) ([a], [a], TT [a], TT [a])
lr of
Left TT [a]
e -> TT [a]
e
Right ([a]
p,[a]
q,TT [a]
pp,TT [a]
qq) ->
let hhs :: [Tree PE]
hhs = [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
pp, TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
qq]
in case POpts
-> String -> [a] -> [a] -> [Tree PE] -> Either (TT [a]) ([a], [a])
forall (t :: Type -> Type) (u :: Type -> Type) a b x.
(Foldable t, Foldable u) =>
POpts
-> String -> t a -> u b -> [Tree PE] -> Either (TT x) ([a], [b])
chkSize2 POpts
opts String
msg0 [a]
p [a]
q [Tree PE]
hhs of
Left TT [a]
e -> TT [a]
e
Right ([a], [a])
_ ->
let d :: [a]
d = [a] -> [[a]] -> [a]
forall a. [a] -> [[a]] -> [a]
intercalate [a]
p ((a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure [a]
q)
in 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] -> [a] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 [a]
d [a]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [a] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " [a]
q) [Tree PE]
hhs
data Elem p q deriving Int -> Elem p q -> ShowS
[Elem p q] -> ShowS
Elem p q -> String
(Int -> Elem p q -> ShowS)
-> (Elem p q -> String) -> ([Elem p q] -> ShowS) -> Show (Elem p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Elem p q -> ShowS
forall k (p :: k) k (q :: k). [Elem p q] -> ShowS
forall k (p :: k) k (q :: k). Elem p q -> String
showList :: [Elem p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Elem p q] -> ShowS
show :: Elem p q -> String
$cshow :: forall k (p :: k) k (q :: k). Elem p q -> String
showsPrec :: Int -> Elem p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Elem p q -> ShowS
Show
instance ( [PP p a] ~ PP q a
, P p a
, P q a
, Show (PP p a)
, Eq (PP p a)
) => P (Elem p q) a where
type PP (Elem p q) a = Bool
eval :: proxy (Elem p q) -> POpts -> a -> m (TT (PP (Elem p q) a))
eval proxy (Elem p q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"Elem"
Either (TT Bool) (PP p a, [PP p a], TT (PP p a), TT [PP p a])
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT Bool) (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 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 Either (TT Bool) (PP p a, [PP p a], TT (PP p a), TT [PP p a])
lr of
Left TT Bool
e -> TT Bool
e
Right (PP p a
p,[PP p a]
q,TT (PP p a)
pp,TT [PP p a]
qq) ->
let b :: Bool
b = PP p a
p PP p a -> [PP p a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [PP p a]
q
in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
b (POpts -> PP p a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" `elem` " 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]
q) [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]
qq]
data Inits deriving Int -> Inits -> ShowS
[Inits] -> ShowS
Inits -> String
(Int -> Inits -> ShowS)
-> (Inits -> String) -> ([Inits] -> ShowS) -> Show Inits
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Inits] -> ShowS
$cshowList :: [Inits] -> ShowS
show :: Inits -> String
$cshow :: Inits -> String
showsPrec :: Int -> Inits -> ShowS
$cshowsPrec :: Int -> Inits -> ShowS
Show
instance ( [a] ~ x
, Show a
) => P Inits x where
type PP Inits x = [x]
eval :: proxy Inits -> POpts -> x -> m (TT (PP Inits x))
eval proxy Inits
_ POpts
opts x
as =
let msg0 :: String
msg0 = String
"Inits"
xs :: [[a]]
xs = [a] -> [[a]]
forall a. [a] -> [[a]]
inits x
[a]
as
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]]
xs) (POpts -> String -> [[a]] -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 [[a]]
xs x
as) []
data Tails deriving Int -> Tails -> ShowS
[Tails] -> ShowS
Tails -> String
(Int -> Tails -> ShowS)
-> (Tails -> String) -> ([Tails] -> ShowS) -> Show Tails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tails] -> ShowS
$cshowList :: [Tails] -> ShowS
show :: Tails -> String
$cshow :: Tails -> String
showsPrec :: Int -> Tails -> ShowS
$cshowsPrec :: Int -> Tails -> ShowS
Show
instance ( [a] ~ x
, Show a
) => P Tails x where
type PP Tails x = [x]
eval :: proxy Tails -> POpts -> x -> m (TT (PP Tails x))
eval proxy Tails
_ POpts
opts x
as =
let msg0 :: String
msg0 = String
"Tails"
xs :: [[a]]
xs = [a] -> [[a]]
forall a. [a] -> [[a]]
tails x
[a]
as
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]]
xs) (POpts -> String -> [[a]] -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 [[a]]
xs x
as) []
data Ones deriving Int -> Ones -> ShowS
[Ones] -> ShowS
Ones -> String
(Int -> Ones -> ShowS)
-> (Ones -> String) -> ([Ones] -> ShowS) -> Show Ones
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ones] -> ShowS
$cshowList :: [Ones] -> ShowS
show :: Ones -> String
$cshow :: Ones -> String
showsPrec :: Int -> Ones -> ShowS
$cshowsPrec :: Int -> Ones -> ShowS
Show
instance x ~ [a] => P Ones x where
type PP Ones x = [x]
eval :: proxy Ones -> POpts -> x -> m (TT (PP Ones x))
eval proxy Ones
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"Ones"
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
$ case POpts -> String -> [a] -> [Tree PE] -> Either (TT [[a]]) [a]
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) [a]
chkSize POpts
opts String
msg0 x
[a]
x [] of
Left TT [[a]]
e -> TT [[a]]
e
Right [a]
_ ->
let d :: [[a]]
d = (a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [a]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure x
[a]
x
in 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) String
msg0 []
data PadImpl (left :: Bool) n p q deriving Int -> PadImpl left n p q -> ShowS
[PadImpl left n p q] -> ShowS
PadImpl left n p q -> String
(Int -> PadImpl left n p q -> ShowS)
-> (PadImpl left n p q -> String)
-> ([PadImpl left n p q] -> ShowS)
-> Show (PadImpl left n p q)
forall (left :: Bool) k (n :: k) k (p :: k) k (q :: k).
Int -> PadImpl left n p q -> ShowS
forall (left :: Bool) k (n :: k) k (p :: k) k (q :: k).
[PadImpl left n p q] -> ShowS
forall (left :: Bool) k (n :: k) k (p :: k) k (q :: k).
PadImpl left n p q -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PadImpl left n p q] -> ShowS
$cshowList :: forall (left :: Bool) k (n :: k) k (p :: k) k (q :: k).
[PadImpl left n p q] -> ShowS
show :: PadImpl left n p q -> String
$cshow :: forall (left :: Bool) k (n :: k) k (p :: k) k (q :: k).
PadImpl left n p q -> String
showsPrec :: Int -> PadImpl left n p q -> ShowS
$cshowsPrec :: forall (left :: Bool) k (n :: k) k (p :: k) k (q :: k).
Int -> PadImpl left n p q -> ShowS
Show
instance ( P n a
, GetBool left
, Integral (PP n a)
, [PP p a] ~ PP q a
, P p a
, P q a
, Show (PP p a)
) => P (PadImpl left n p q) a where
type PP (PadImpl left n p q) a = PP q a
eval :: proxy (PadImpl left n p q)
-> POpts -> a -> m (TT (PP (PadImpl left n p q) a))
eval proxy (PadImpl left n p q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"Pad" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (if Bool
lft then String
"L" else String
"R")
lft :: Bool
lft = GetBool left => Bool
forall (a :: Bool). GetBool a => Bool
getBool @left
Either (TT [PP p a]) (PP n a, PP p a, TT (PP n a), TT (PP p a))
lr <- Inline
-> String
-> Proxy n
-> Proxy p
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT [PP p a]) (PP n a, PP p a, TT (PP n a), TT (PP p 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 n
forall k (t :: k). Proxy t
Proxy @n) (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a []
case Either (TT [PP p a]) (PP n a, PP p a, TT (PP n a), TT (PP p a))
lr of
Left TT [PP p a]
e -> TT [PP p a] -> m (TT [PP p a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [PP p a]
e
Right (PP n a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n,PP p a
p,TT (PP n a)
nn,TT (PP p a)
pp) -> do
let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" pad=" 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
hhs :: [Tree PE]
hhs = [TT (PP n a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP n a)
nn, TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]
TT [PP p a]
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
a
TT [PP p a] -> m (TT [PP p a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [PP p a] -> m (TT [PP p a])) -> TT [PP p a] -> m (TT [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]
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" q failed") TT [PP p a]
qq [Tree PE]
hhs of
Left TT [PP p a]
e -> TT [PP p a]
e
Right [PP p a]
q ->
let l :: Int
l = [PP p a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [PP p a]
q
diff :: Int
diff = if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
l then Int
0 else Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
l
bs :: [PP p a]
bs = if Bool
lft
then Int -> PP p a -> [PP p a]
forall a. Int -> a -> [a]
replicate Int
diff PP p a
p [PP p a] -> [PP p a] -> [PP p a]
forall a. Semigroup a => a -> a -> a
<> [PP p a]
q
else [PP p a]
q [PP p a] -> [PP p a] -> [PP p a]
forall a. Semigroup a => a -> a -> a
<> Int -> PP p a -> [PP p a]
forall a. Int -> a -> [a]
replicate Int
diff PP p a
p
in POpts -> Val [PP p a] -> String -> [Tree PE] -> TT [PP p a]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([PP p a] -> Val [PP p a]
forall a. a -> Val a
Val [PP p a]
bs) (POpts -> String -> [PP p a] -> [PP p a] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg1 [PP p a]
bs [PP p a]
q) ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. Semigroup a => a -> a -> a
<> [TT [PP p a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [PP p a]
qq])
data PadL n p q deriving Int -> PadL n p q -> ShowS
[PadL n p q] -> ShowS
PadL n p q -> String
(Int -> PadL n p q -> ShowS)
-> (PadL n p q -> String)
-> ([PadL n p q] -> ShowS)
-> Show (PadL n p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k) k (p :: k) k (q :: k). Int -> PadL n p q -> ShowS
forall k (n :: k) k (p :: k) k (q :: k). [PadL n p q] -> ShowS
forall k (n :: k) k (p :: k) k (q :: k). PadL n p q -> String
showList :: [PadL n p q] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k) k (q :: k). [PadL n p q] -> ShowS
show :: PadL n p q -> String
$cshow :: forall k (n :: k) k (p :: k) k (q :: k). PadL n p q -> String
showsPrec :: Int -> PadL n p q -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k) k (q :: k). Int -> PadL n p q -> ShowS
Show
type PadLT n p q = PadImpl 'True n p q
instance P (PadLT n p q) x => P (PadL n p q) x where
type PP (PadL n p q) x = PP (PadLT n p q) x
eval :: proxy (PadL n p q) -> POpts -> x -> m (TT (PP (PadL n p q) x))
eval proxy (PadL n p q)
_ = Proxy (PadLT n p q) -> POpts -> x -> m (TT (PP (PadLT n 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 (PadLT n p q)
forall k (t :: k). Proxy t
Proxy @(PadLT n p q))
data PadR n p q deriving Int -> PadR n p q -> ShowS
[PadR n p q] -> ShowS
PadR n p q -> String
(Int -> PadR n p q -> ShowS)
-> (PadR n p q -> String)
-> ([PadR n p q] -> ShowS)
-> Show (PadR n p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k) k (p :: k) k (q :: k). Int -> PadR n p q -> ShowS
forall k (n :: k) k (p :: k) k (q :: k). [PadR n p q] -> ShowS
forall k (n :: k) k (p :: k) k (q :: k). PadR n p q -> String
showList :: [PadR n p q] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k) k (q :: k). [PadR n p q] -> ShowS
show :: PadR n p q -> String
$cshow :: forall k (n :: k) k (p :: k) k (q :: k). PadR n p q -> String
showsPrec :: Int -> PadR n p q -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k) k (q :: k). Int -> PadR n p q -> ShowS
Show
type PadRT n p q = PadImpl 'False n p q
instance P (PadRT n p q) x => P (PadR n p q) x where
type PP (PadR n p q) x = PP (PadRT n p q) x
eval :: proxy (PadR n p q) -> POpts -> x -> m (TT (PP (PadR n p q) x))
eval proxy (PadR n p q)
_ = Proxy (PadRT n p q) -> POpts -> x -> m (TT (PP (PadRT n 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 (PadRT n p q)
forall k (t :: k). Proxy t
Proxy @(PadRT n p q))
data SplitAts ns p deriving Int -> SplitAts ns p -> ShowS
[SplitAts ns p] -> ShowS
SplitAts ns p -> String
(Int -> SplitAts ns p -> ShowS)
-> (SplitAts ns p -> String)
-> ([SplitAts ns p] -> ShowS)
-> Show (SplitAts ns p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (ns :: k) k (p :: k). Int -> SplitAts ns p -> ShowS
forall k (ns :: k) k (p :: k). [SplitAts ns p] -> ShowS
forall k (ns :: k) k (p :: k). SplitAts ns p -> String
showList :: [SplitAts ns p] -> ShowS
$cshowList :: forall k (ns :: k) k (p :: k). [SplitAts ns p] -> ShowS
show :: SplitAts ns p -> String
$cshow :: forall k (ns :: k) k (p :: k). SplitAts ns p -> String
showsPrec :: Int -> SplitAts ns p -> ShowS
$cshowsPrec :: forall k (ns :: k) k (p :: k). Int -> SplitAts ns p -> ShowS
Show
instance ( P ns x
, P p x
, PP p x ~ [a]
, Show n
, Show a
, PP ns x ~ [n]
, Integral n
) => P (SplitAts ns p) x where
type PP (SplitAts ns p) x = [PP p x]
eval :: proxy (SplitAts ns p)
-> POpts -> x -> m (TT (PP (SplitAts ns p) x))
eval proxy (SplitAts ns p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"SplitAts"
Either (TT [[a]]) ([n], [a], TT [n], TT [a])
lr <- Inline
-> String
-> Proxy ns
-> Proxy p
-> POpts
-> x
-> [Tree PE]
-> m (Either
(TT [[a]]) (PP ns x, PP p x, TT (PP ns x), TT (PP p 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 ns
forall k (t :: k). Proxy t
Proxy @ns) (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts x
x []
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 Either (TT [[a]]) ([n], [a], TT [n], TT [a])
lr of
Left TT [[a]]
e -> TT [[a]]
e
Right ([n]
ns,[a]
p,TT [n]
nn,TT [a]
pp) ->
let zs :: [[a]]
zs = (n -> ([a] -> [[a]]) -> [a] -> [[a]])
-> ([a] -> [[a]]) -> [n] -> [a] -> [[a]]
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\n
n [a] -> [[a]]
k [a]
s -> let ([a]
a,[a]
b) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAtNeg (n -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
n) [a]
s
in [a]
a[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[a] -> [[a]]
k [a]
b
) (\[a]
as -> [[a]
as | Bool -> Bool
not ([a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [a]
as)]) [n]
ns [a]
p
in 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]]
zs) (POpts -> String -> [[a]] -> String -> [n] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [[a]]
zs String
"ns=" [n]
ns String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [a] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " [a]
p) [TT [n] -> Tree PE
forall a. TT a -> Tree PE
hh TT [n]
nn, TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
pp]
data SplitAt n p deriving Int -> SplitAt n p -> ShowS
[SplitAt n p] -> ShowS
SplitAt n p -> String
(Int -> SplitAt n p -> ShowS)
-> (SplitAt n p -> String)
-> ([SplitAt n p] -> ShowS)
-> Show (SplitAt n p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k) k (p :: k). Int -> SplitAt n p -> ShowS
forall k (n :: k) k (p :: k). [SplitAt n p] -> ShowS
forall k (n :: k) k (p :: k). SplitAt n p -> String
showList :: [SplitAt n p] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k). [SplitAt n p] -> ShowS
show :: SplitAt n p -> String
$cshow :: forall k (n :: k) k (p :: k). SplitAt n p -> String
showsPrec :: Int -> SplitAt n p -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k). Int -> SplitAt n p -> ShowS
Show
instance ( PP p a ~ [b]
, P n a
, P p a
, Show b
, Integral (PP n a)
) => P (SplitAt n p) a where
type PP (SplitAt n p) a = (PP p a, PP p a)
eval :: proxy (SplitAt n p) -> POpts -> a -> m (TT (PP (SplitAt n p) a))
eval proxy (SplitAt n p)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"SplitAt"
Either (TT ([b], [b])) (PP n a, [b], TT (PP n a), TT [b])
lr <- Inline
-> String
-> Proxy n
-> Proxy p
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT ([b], [b])) (PP n a, PP p a, TT (PP n a), TT (PP p 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 n
forall k (t :: k). Proxy t
Proxy @n) (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a []
TT ([b], [b]) -> m (TT ([b], [b]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT ([b], [b]) -> m (TT ([b], [b])))
-> TT ([b], [b]) -> m (TT ([b], [b]))
forall a b. (a -> b) -> a -> b
$ case Either (TT ([b], [b])) (PP n a, [b], TT (PP n a), TT [b])
lr of
Left TT ([b], [b])
e -> TT ([b], [b])
e
Right (PP n a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n,[b]
p,TT (PP n a)
pp,TT [b]
qq) ->
let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
n 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]
p
ret :: ([b], [b])
ret = Int -> [b] -> ([b], [b])
forall a. Int -> [a] -> ([a], [a])
splitAtNeg Int
n [b]
p
in POpts -> Val ([b], [b]) -> String -> [Tree PE] -> TT ([b], [b])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (([b], [b]) -> Val ([b], [b])
forall a. a -> Val a
Val ([b], [b])
ret) (POpts -> String -> ([b], [b]) -> String -> Int -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg1 ([b], [b])
ret String
"n=" Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [b] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " [b]
p) [TT (PP n a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP n a)
pp, TT [b] -> Tree PE
forall a. TT a -> Tree PE
hh TT [b]
qq]
splitAtNeg :: Int -> [a] -> ([a], [a])
splitAtNeg :: Int -> [a] -> ([a], [a])
splitAtNeg Int
n [a]
as = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 then [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [a]
as Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n else Int
n) [a]
as
data Take n p deriving Int -> Take n p -> ShowS
[Take n p] -> ShowS
Take n p -> String
(Int -> Take n p -> ShowS)
-> (Take n p -> String) -> ([Take n p] -> ShowS) -> Show (Take n p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k) k (p :: k). Int -> Take n p -> ShowS
forall k (n :: k) k (p :: k). [Take n p] -> ShowS
forall k (n :: k) k (p :: k). Take n p -> String
showList :: [Take n p] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k). [Take n p] -> ShowS
show :: Take n p -> String
$cshow :: forall k (n :: k) k (p :: k). Take n p -> String
showsPrec :: Int -> Take n p -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k). Int -> Take n p -> ShowS
Show
type TakeT n p = SplitAt n p >> Fst
instance P (TakeT n p) x => P (Take n p) x where
type PP (Take n p) x = PP (TakeT n p) x
eval :: proxy (Take n p) -> POpts -> x -> m (TT (PP (Take n p) x))
eval proxy (Take n p)
_ = Proxy (TakeT n p) -> POpts -> x -> m (TT (PP (TakeT n 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 (TakeT n p)
forall k (t :: k). Proxy t
Proxy @(TakeT n p))
data Drop n p deriving Int -> Drop n p -> ShowS
[Drop n p] -> ShowS
Drop n p -> String
(Int -> Drop n p -> ShowS)
-> (Drop n p -> String) -> ([Drop n p] -> ShowS) -> Show (Drop n p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k) k (p :: k). Int -> Drop n p -> ShowS
forall k (n :: k) k (p :: k). [Drop n p] -> ShowS
forall k (n :: k) k (p :: k). Drop n p -> String
showList :: [Drop n p] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k). [Drop n p] -> ShowS
show :: Drop n p -> String
$cshow :: forall k (n :: k) k (p :: k). Drop n p -> String
showsPrec :: Int -> Drop n p -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k). Int -> Drop n p -> ShowS
Show
type DropT n p = SplitAt n p >> Snd
instance P (DropT n p) x => P (Drop n p) x where
type PP (Drop n p) x = PP (DropT n p) x
eval :: proxy (Drop n p) -> POpts -> x -> m (TT (PP (Drop n p) x))
eval proxy (Drop n p)
_ = Proxy (DropT n p) -> POpts -> x -> m (TT (PP (DropT n 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 (DropT n p)
forall k (t :: k). Proxy t
Proxy @(DropT n p))
data ChunksOf n deriving Int -> ChunksOf n -> ShowS
[ChunksOf n] -> ShowS
ChunksOf n -> String
(Int -> ChunksOf n -> ShowS)
-> (ChunksOf n -> String)
-> ([ChunksOf n] -> ShowS)
-> Show (ChunksOf n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k). Int -> ChunksOf n -> ShowS
forall k (n :: k). [ChunksOf n] -> ShowS
forall k (n :: k). ChunksOf n -> String
showList :: [ChunksOf n] -> ShowS
$cshowList :: forall k (n :: k). [ChunksOf n] -> ShowS
show :: ChunksOf n -> String
$cshow :: forall k (n :: k). ChunksOf n -> String
showsPrec :: Int -> ChunksOf n -> ShowS
$cshowsPrec :: forall k (n :: k). Int -> ChunksOf n -> ShowS
Show
type ChunksOfT n = ChunksOf' n n Id
instance P (ChunksOfT n) x => P (ChunksOf n) x where
type PP (ChunksOf n) x = PP (ChunksOfT n) x
eval :: proxy (ChunksOf n) -> POpts -> x -> m (TT (PP (ChunksOf n) x))
eval proxy (ChunksOf n)
_ = Proxy (ChunksOfT n) -> POpts -> x -> m (TT (PP (ChunksOfT n) 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 (ChunksOfT n)
forall k (t :: k). Proxy t
Proxy @(ChunksOfT n))
data ChunksOf' n i p deriving Int -> ChunksOf' n i p -> ShowS
[ChunksOf' n i p] -> ShowS
ChunksOf' n i p -> String
(Int -> ChunksOf' n i p -> ShowS)
-> (ChunksOf' n i p -> String)
-> ([ChunksOf' n i p] -> ShowS)
-> Show (ChunksOf' n i p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k) k (i :: k) k (p :: k).
Int -> ChunksOf' n i p -> ShowS
forall k (n :: k) k (i :: k) k (p :: k). [ChunksOf' n i p] -> ShowS
forall k (n :: k) k (i :: k) k (p :: k). ChunksOf' n i p -> String
showList :: [ChunksOf' n i p] -> ShowS
$cshowList :: forall k (n :: k) k (i :: k) k (p :: k). [ChunksOf' n i p] -> ShowS
show :: ChunksOf' n i p -> String
$cshow :: forall k (n :: k) k (i :: k) k (p :: k). ChunksOf' n i p -> String
showsPrec :: Int -> ChunksOf' n i p -> ShowS
$cshowsPrec :: forall k (n :: k) k (i :: k) k (p :: k).
Int -> ChunksOf' n i p -> ShowS
Show
instance ( PP p a ~ [b]
, P n a
, P i a
, P p a
, Show b
, Integral (PP i a)
, Integral (PP n a)
) => P (ChunksOf' n i p) a where
type PP (ChunksOf' n i p) a = [PP p a]
eval :: proxy (ChunksOf' n i p)
-> POpts -> a -> m (TT (PP (ChunksOf' n i p) a))
eval proxy (ChunksOf' n i p)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"ChunksOf"
Either (TT [[b]]) (PP n a, PP i a, TT (PP n a), TT (PP i a))
lr <- Inline
-> String
-> Proxy n
-> Proxy i
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT [[b]]) (PP n a, PP i a, TT (PP n a), TT (PP i 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 n
forall k (t :: k). Proxy t
Proxy @n) (Proxy i
forall k (t :: k). Proxy t
Proxy @i) POpts
opts a
a []
case Either (TT [[b]]) (PP n a, PP i a, TT (PP n a), TT (PP i a))
lr of
Left TT [[b]]
e -> TT [[b]] -> m (TT [[b]])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [[b]]
e
Right (PP n a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n,PP i a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
i,TT (PP n a)
nn,TT (PP i a)
ii) -> do
let hhs :: [Tree PE]
hhs = [TT (PP n a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP n a)
nn, TT (PP i a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP i a)
ii]
msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> (Int, Int) -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts (Int
n,Int
i)
TT [b]
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 [[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 Inline
-> POpts -> String -> TT [b] -> [Tree PE] -> Either (TT [[b]]) [b]
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" p failed") TT [b]
pp [Tree PE]
hhs of
Left TT [[b]]
e -> TT [[b]]
e
Right [b]
p ->
let hhs1 :: [Tree PE]
hhs1 = [Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT [b] -> Tree PE
forall a. TT a -> Tree PE
hh TT [b]
pp]
in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then POpts -> Val [[b]] -> String -> [Tree PE] -> TT [[b]]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val [[b]]
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" n<=0")) String
"" [Tree PE]
hhs1
else if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then POpts -> Val [[b]] -> String -> [Tree PE] -> TT [[b]]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val [[b]]
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" i<1")) String
"" [Tree PE]
hhs1
else let ret :: [[b]]
ret = ([b] -> Maybe ([b], [b])) -> [b] -> [[b]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\[b]
s -> if [b] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null [b]
s then Maybe ([b], [b])
forall a. Maybe a
Nothing else ([b], [b]) -> Maybe ([b], [b])
forall a. a -> Maybe a
Just (Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
take Int
n [b]
s,Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
drop Int
i [b]
s)) [b]
p
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]]
ret) (POpts -> String -> [[b]] -> String -> (Int, Int) -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg1 [[b]]
ret String
"n,i=" (Int
n,Int
i) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [b] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " [b]
p) [Tree PE]
hhs1
data KeepImpl (keep :: Bool) p q deriving Int -> KeepImpl keep p q -> ShowS
[KeepImpl keep p q] -> ShowS
KeepImpl keep p q -> String
(Int -> KeepImpl keep p q -> ShowS)
-> (KeepImpl keep p q -> String)
-> ([KeepImpl keep p q] -> ShowS)
-> Show (KeepImpl keep p q)
forall (keep :: Bool) k (p :: k) k (q :: k).
Int -> KeepImpl keep p q -> ShowS
forall (keep :: Bool) k (p :: k) k (q :: k).
[KeepImpl keep p q] -> ShowS
forall (keep :: Bool) k (p :: k) k (q :: k).
KeepImpl keep p q -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeepImpl keep p q] -> ShowS
$cshowList :: forall (keep :: Bool) k (p :: k) k (q :: k).
[KeepImpl keep p q] -> ShowS
show :: KeepImpl keep p q -> String
$cshow :: forall (keep :: Bool) k (p :: k) k (q :: k).
KeepImpl keep p q -> String
showsPrec :: Int -> KeepImpl keep p q -> ShowS
$cshowsPrec :: forall (keep :: Bool) k (p :: k) k (q :: k).
Int -> KeepImpl keep p q -> ShowS
Show
instance ( GetBool keep
, Eq a
, Show a
, P p x
, P q x
, PP p x ~ PP q x
, PP q x ~ [a]
) => P (KeepImpl keep p q) x where
type PP (KeepImpl keep p q) x = PP q x
eval :: proxy (KeepImpl keep p q)
-> POpts -> x -> m (TT (PP (KeepImpl keep p q) x))
eval proxy (KeepImpl keep p q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = if Bool
keep then String
"Keep" else String
"Remove"
keep :: Bool
keep = GetBool keep => Bool
forall (a :: Bool). GetBool a => Bool
getBool @keep
Either (TT [a]) ([a], [a], TT [a], TT [a])
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT [a]) (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 [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 Either (TT [a]) ([a], [a], TT [a], TT [a])
lr of
Left TT [a]
e -> TT [a]
e
Right ([a]
p,[a]
q,TT [a]
pp,TT [a]
qq) ->
let ret :: [a]
ret = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Bool -> Bool) -> (Bool -> Bool) -> Bool -> Bool -> Bool
forall a. a -> a -> Bool -> a
bool Bool -> Bool
not Bool -> Bool
forall a. a -> a
id Bool
keep (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` [a]
p)) [a]
q
in 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]
ret) (POpts -> String -> [a] -> String -> [a] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [a]
ret String
"p=" [a]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [a] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [a]
q) [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
pp, TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
qq]
data Keep p q deriving Int -> Keep p q -> ShowS
[Keep p q] -> ShowS
Keep p q -> String
(Int -> Keep p q -> ShowS)
-> (Keep p q -> String) -> ([Keep p q] -> ShowS) -> Show (Keep p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Keep p q -> ShowS
forall k (p :: k) k (q :: k). [Keep p q] -> ShowS
forall k (p :: k) k (q :: k). Keep p q -> String
showList :: [Keep p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Keep p q] -> ShowS
show :: Keep p q -> String
$cshow :: forall k (p :: k) k (q :: k). Keep p q -> String
showsPrec :: Int -> Keep p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Keep p q -> ShowS
Show
type KeepT p q = KeepImpl 'True p q
instance P (KeepT p q) x => P (Keep p q) x where
type PP (Keep p q) x = PP (KeepT p q) x
eval :: proxy (Keep p q) -> POpts -> x -> m (TT (PP (Keep p q) x))
eval proxy (Keep p q)
_ = Proxy (KeepT p q) -> POpts -> x -> m (TT (PP (KeepT 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 (KeepT p q)
forall k (t :: k). Proxy t
Proxy @(KeepT p q))
data Remove p q deriving Int -> Remove p q -> ShowS
[Remove p q] -> ShowS
Remove p q -> String
(Int -> Remove p q -> ShowS)
-> (Remove p q -> String)
-> ([Remove p q] -> ShowS)
-> Show (Remove p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Remove p q -> ShowS
forall k (p :: k) k (q :: k). [Remove p q] -> ShowS
forall k (p :: k) k (q :: k). Remove p q -> String
showList :: [Remove p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Remove p q] -> ShowS
show :: Remove p q -> String
$cshow :: forall k (p :: k) k (q :: k). Remove p q -> String
showsPrec :: Int -> Remove p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Remove p q -> ShowS
Show
type RemoveT p q = KeepImpl 'False p q
instance P (RemoveT p q) x => P (Remove p q) x where
type PP (Remove p q) x = PP (RemoveT p q) x
eval :: proxy (Remove p q) -> POpts -> x -> m (TT (PP (Remove p q) x))
eval proxy (Remove p q)
_ = Proxy (RemoveT p q) -> POpts -> x -> m (TT (PP (RemoveT 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 (RemoveT p q)
forall k (t :: k). Proxy t
Proxy @(RemoveT p q))
data Head deriving Int -> Head -> ShowS
[Head] -> ShowS
Head -> String
(Int -> Head -> ShowS)
-> (Head -> String) -> ([Head] -> ShowS) -> Show Head
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Head] -> ShowS
$cshowList :: [Head] -> ShowS
show :: Head -> String
$cshow :: Head -> String
showsPrec :: Int -> Head -> ShowS
$cshowsPrec :: Int -> Head -> ShowS
Show
instance ( Cons x x (ConsT x) (ConsT x)
, Show (ConsT x)
, Show x
) => P Head x where
type PP Head x = ConsT x
eval :: proxy Head -> POpts -> x -> m (TT (PP Head x))
eval proxy Head
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"Head"
in TT (ConsT x) -> m (TT (ConsT x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ConsT x) -> m (TT (ConsT x)))
-> TT (ConsT x) -> m (TT (ConsT x))
forall a b. (a -> b) -> a -> b
$ case x
x x
-> Getting (First (ConsT x, x)) x (ConsT x, x)
-> Maybe (ConsT x, x)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First (ConsT x, x)) x (ConsT x, x)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons of
Maybe (ConsT x, x)
Nothing -> POpts -> Val (ConsT x) -> String -> [Tree PE] -> TT (ConsT x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (ConsT x)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(empty)")) String
"" []
Just (ConsT x
a,x
_) -> POpts -> Val (ConsT x) -> String -> [Tree PE] -> TT (ConsT x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ConsT x -> Val (ConsT x)
forall a. a -> Val a
Val ConsT x
a) (POpts -> String -> ConsT x -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 ConsT x
a x
x) []
data Tail deriving Int -> Tail -> ShowS
[Tail] -> ShowS
Tail -> String
(Int -> Tail -> ShowS)
-> (Tail -> String) -> ([Tail] -> ShowS) -> Show Tail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tail] -> ShowS
$cshowList :: [Tail] -> ShowS
show :: Tail -> String
$cshow :: Tail -> String
showsPrec :: Int -> Tail -> ShowS
$cshowsPrec :: Int -> Tail -> ShowS
Show
instance ( Cons x x (ConsT x) (ConsT x)
, Show x
) => P Tail x where
type PP Tail x = x
eval :: proxy Tail -> POpts -> x -> m (TT (PP Tail x))
eval proxy Tail
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Tail"
TT x -> m (TT x)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT x -> m (TT x)) -> TT x -> m (TT x)
forall a b. (a -> b) -> a -> b
$ case x
x x
-> Getting (First (ConsT x, x)) x (ConsT x, x)
-> Maybe (ConsT x, x)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First (ConsT x, x)) x (ConsT x, x)
forall s t a b. Cons s t a b => Prism s t (a, s) (b, t)
_Cons of
Maybe (ConsT x, x)
Nothing -> POpts -> Val x -> String -> [Tree PE] -> TT x
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val x
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(empty)")) String
"" []
Just (ConsT x
_,x
as) -> POpts -> Val x -> String -> [Tree PE] -> TT x
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (x -> Val x
forall a. a -> Val a
Val x
as) (POpts -> String -> x -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 x
as x
x) []
data Last deriving Int -> Last -> ShowS
[Last] -> ShowS
Last -> String
(Int -> Last -> ShowS)
-> (Last -> String) -> ([Last] -> ShowS) -> Show Last
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Last] -> ShowS
$cshowList :: [Last] -> ShowS
show :: Last -> String
$cshow :: Last -> String
showsPrec :: Int -> Last -> ShowS
$cshowsPrec :: Int -> Last -> ShowS
Show
instance ( Snoc x x (ConsT x) (ConsT x)
, Show (ConsT x)
, Show x
) => P Last x where
type PP Last x = ConsT x
eval :: proxy Last -> POpts -> x -> m (TT (PP Last x))
eval proxy Last
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"Last"
in TT (ConsT x) -> m (TT (ConsT x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (ConsT x) -> m (TT (ConsT x)))
-> TT (ConsT x) -> m (TT (ConsT x))
forall a b. (a -> b) -> a -> b
$ case x
x x
-> Getting (First (x, ConsT x)) x (x, ConsT x)
-> Maybe (x, ConsT x)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First (x, ConsT x)) x (x, ConsT x)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc of
Maybe (x, ConsT x)
Nothing -> POpts -> Val (ConsT x) -> String -> [Tree PE] -> TT (ConsT x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (ConsT x)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(empty)")) String
"" []
Just (x
_,ConsT x
a) -> POpts -> Val (ConsT x) -> String -> [Tree PE] -> TT (ConsT x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (ConsT x -> Val (ConsT x)
forall a. a -> Val a
Val ConsT x
a) (POpts -> String -> ConsT x -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 ConsT x
a x
x) []
data Init deriving Int -> Init -> ShowS
[Init] -> ShowS
Init -> String
(Int -> Init -> ShowS)
-> (Init -> String) -> ([Init] -> ShowS) -> Show Init
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Init] -> ShowS
$cshowList :: [Init] -> ShowS
show :: Init -> String
$cshow :: Init -> String
showsPrec :: Int -> Init -> ShowS
$cshowsPrec :: Int -> Init -> ShowS
Show
instance ( Snoc s s (ConsT s) (ConsT s)
, x ~ s
, Show s
) => P Init x where
type PP Init x = x
eval :: proxy Init -> POpts -> x -> m (TT (PP Init x))
eval proxy Init
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Init"
TT s -> m (TT s)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT s -> m (TT s)) -> TT s -> m (TT s)
forall a b. (a -> b) -> a -> b
$ case x
x x
-> Getting (First (s, ConsT s)) x (s, ConsT s)
-> Maybe (s, ConsT s)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First (s, ConsT s)) x (s, ConsT s)
forall s t a b. Snoc s t a b => Prism s t (s, a) (t, b)
_Snoc of
Maybe (s, ConsT s)
Nothing -> POpts -> Val s -> String -> [Tree PE] -> TT s
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val s
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(empty)")) String
"" []
Just (s
as,ConsT s
_) -> POpts -> Val s -> String -> [Tree PE] -> TT s
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (s -> Val s
forall a. a -> Val a
Val s
as) (POpts -> String -> s -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 s
as x
x) []
data Unzip deriving Int -> Unzip -> ShowS
[Unzip] -> ShowS
Unzip -> String
(Int -> Unzip -> ShowS)
-> (Unzip -> String) -> ([Unzip] -> ShowS) -> Show Unzip
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unzip] -> ShowS
$cshowList :: [Unzip] -> ShowS
show :: Unzip -> String
$cshow :: Unzip -> String
showsPrec :: Int -> Unzip -> ShowS
$cshowsPrec :: Int -> Unzip -> ShowS
Show
type UnzipT = '(Map Fst, Map Snd)
instance P UnzipT x => P Unzip x where
type PP Unzip x = PP UnzipT x
eval :: proxy Unzip -> POpts -> x -> m (TT (PP Unzip x))
eval proxy Unzip
_ = Proxy UnzipT -> POpts -> x -> m (TT (PP UnzipT 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 UnzipT
forall k (t :: k). Proxy t
Proxy @UnzipT)
data Unzip3 deriving Int -> Unzip3 -> ShowS
[Unzip3] -> ShowS
Unzip3 -> String
(Int -> Unzip3 -> ShowS)
-> (Unzip3 -> String) -> ([Unzip3] -> ShowS) -> Show Unzip3
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unzip3] -> ShowS
$cshowList :: [Unzip3] -> ShowS
show :: Unzip3 -> String
$cshow :: Unzip3 -> String
showsPrec :: Int -> Unzip3 -> ShowS
$cshowsPrec :: Int -> Unzip3 -> ShowS
Show
type Unzip3T = '(Map Fst, Map Snd, Map Thd)
instance P Unzip3T x => P Unzip3 x where
type PP Unzip3 x = PP Unzip3T x
eval :: proxy Unzip3 -> POpts -> x -> m (TT (PP Unzip3 x))
eval proxy Unzip3
_ = Proxy Unzip3T -> POpts -> x -> m (TT (PP Unzip3T 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 Unzip3T
forall k (t :: k). Proxy t
Proxy @Unzip3T)
data SortBy p q deriving Int -> SortBy p q -> ShowS
[SortBy p q] -> ShowS
SortBy p q -> String
(Int -> SortBy p q -> ShowS)
-> (SortBy p q -> String)
-> ([SortBy p q] -> ShowS)
-> Show (SortBy p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> SortBy p q -> ShowS
forall k (p :: k) k (q :: k). [SortBy p q] -> ShowS
forall k (p :: k) k (q :: k). SortBy p q -> String
showList :: [SortBy p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [SortBy p q] -> ShowS
show :: SortBy p q -> String
$cshow :: forall k (p :: k) k (q :: k). SortBy p q -> String
showsPrec :: Int -> SortBy p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> SortBy p q -> ShowS
Show
type SortByHelperT p = Partition (p == 'GT) Id
instance ( P p (a,a)
, P q x
, Show a
, PP q x ~ [a]
, PP p (a,a) ~ Ordering
) => P (SortBy p q) x where
type PP (SortBy p q) x = PP q x
eval :: proxy (SortBy p q) -> POpts -> x -> m (TT (PP (SortBy p q) x))
eval proxy (SortBy p q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"SortBy"
TT [a]
qq <- Proxy q -> POpts -> x -> m (TT (PP 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 q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x
case Inline
-> POpts -> String -> TT [a] -> [Tree PE] -> Either (TT [a]) [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
" q failed") TT [a]
qq [] of
Left TT [a]
e -> TT [a] -> m (TT [a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [a]
e
Right [a]
as -> do
let ff :: MonadEval m => [a] -> m (TT [a])
ff :: [a] -> m (TT [a])
ff = \case
[] -> 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]
forall a. Monoid a => a
mempty) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" empty") [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
qq]
[a
w] -> 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
w]) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" one element " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
w) [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
qq]
a
w:ys :: [a]
ys@(a
_:[a]
_) -> do
TT ([(a, a)], [(a, a)])
pp <- POpts -> [(a, a)] -> m (TT (PP (SortByHelperT p) [(a, a)]))
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p a) =>
POpts -> a -> m (TT (PP p a))
evalHide @(SortByHelperT p) POpts
opts ((a -> (a, a)) -> [a] -> [(a, a)]
forall a b. (a -> b) -> [a] -> [b]
map (a
w,) [a]
ys)
case Inline
-> POpts
-> String
-> TT ([(a, a)], [(a, a)])
-> [Tree PE]
-> Either (TT [a]) ([(a, a)], [(a, a)])
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT ([(a, a)], [(a, a)])
pp [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
qq] of
Left TT [a]
e -> TT [a] -> m (TT [a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [a]
e
Right ([(a, a)]
ll', [(a, a)]
rr') -> do
TT [a]
lhs <- [a] -> m (TT [a])
forall (m :: Type -> Type). MonadEval m => [a] -> m (TT [a])
ff (((a, a) -> a) -> [(a, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> a
forall a b. (a, b) -> b
snd [(a, a)]
ll')
case Inline
-> POpts -> String -> TT [a] -> [Tree PE] -> Either (TT Any) [a]
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT [a]
lhs [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
qq, TT ([(a, a)], [(a, a)]) -> Tree PE
forall a. TT a -> Tree PE
hh TT ([(a, a)], [(a, a)])
pp] of
Left TT Any
_ -> TT [a] -> m (TT [a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [a]
lhs
Right [a]
ll -> do
TT [a]
rhs <- [a] -> m (TT [a])
forall (m :: Type -> Type). MonadEval m => [a] -> m (TT [a])
ff (((a, a) -> a) -> [(a, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a, a) -> a
forall a b. (a, b) -> b
snd [(a, a)]
rr')
case Inline
-> POpts -> String -> TT [a] -> [Tree PE] -> Either (TT Any) [a]
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT [a]
rhs [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
qq, TT ([(a, a)], [(a, a)]) -> Tree PE
forall a. TT a -> Tree PE
hh TT ([(a, a)], [(a, a)])
pp, TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
lhs] of
Left TT Any
_ -> TT [a] -> m (TT [a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [a]
rhs
Right [a]
rr ->
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]
ll [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
w a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rr))
(String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" lhs=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> [a] -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts [a]
ll String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" pivot " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
w String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" rhs=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> [a] -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts [a]
rr)
(TT ([(a, a)], [(a, a)]) -> Tree PE
forall a. TT a -> Tree PE
hh TT ([(a, a)], [(a, a)])
pp Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
lhs | [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [a]
ll Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1] [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
rhs | [a] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [a]
rr Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1])
TT [a]
ret <- [a] -> m (TT [a])
forall (m :: Type -> Type). MonadEval m => [a] -> m (TT [a])
ff [a]
as
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 [a] -> [Tree PE] -> Either (TT Any) [a]
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT [a]
ret [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
qq] of
Left TT Any
_e -> TT [a]
ret
Right [a]
xs -> POpts -> TT [a] -> String -> [Tree PE] -> TT [a]
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT [a]
ret (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]
xs) [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
qq, TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
ret]
data SortOn p q deriving Int -> SortOn p q -> ShowS
[SortOn p q] -> ShowS
SortOn p q -> String
(Int -> SortOn p q -> ShowS)
-> (SortOn p q -> String)
-> ([SortOn p q] -> ShowS)
-> Show (SortOn p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> SortOn p q -> ShowS
forall k (p :: k) k (q :: k). [SortOn p q] -> ShowS
forall k (p :: k) k (q :: k). SortOn p q -> String
showList :: [SortOn p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [SortOn p q] -> ShowS
show :: SortOn p q -> String
$cshow :: forall k (p :: k) k (q :: k). SortOn p q -> String
showsPrec :: Int -> SortOn p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> SortOn p q -> ShowS
Show
type SortOnT p q = SortBy (OrdA' p p) q
instance P (SortOnT p q) x => P (SortOn p q) x where
type PP (SortOn p q) x = PP (SortOnT p q) x
eval :: proxy (SortOn p q) -> POpts -> x -> m (TT (PP (SortOn p q) x))
eval proxy (SortOn p q)
_ = Proxy (SortOnT p q) -> POpts -> x -> m (TT (PP (SortOnT 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 (SortOnT p q)
forall k (t :: k). Proxy t
Proxy @(SortOnT p q))
data SortOnDesc p q deriving Int -> SortOnDesc p q -> ShowS
[SortOnDesc p q] -> ShowS
SortOnDesc p q -> String
(Int -> SortOnDesc p q -> ShowS)
-> (SortOnDesc p q -> String)
-> ([SortOnDesc p q] -> ShowS)
-> Show (SortOnDesc p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> SortOnDesc p q -> ShowS
forall k (p :: k) k (q :: k). [SortOnDesc p q] -> ShowS
forall k (p :: k) k (q :: k). SortOnDesc p q -> String
showList :: [SortOnDesc p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [SortOnDesc p q] -> ShowS
show :: SortOnDesc p q -> String
$cshow :: forall k (p :: k) k (q :: k). SortOnDesc p q -> String
showsPrec :: Int -> SortOnDesc p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> SortOnDesc p q -> ShowS
Show
type SortOnDescT p q = SortBy (Swap >> OrdA' p p) q
instance P (SortOnDescT p q) x => P (SortOnDesc p q) x where
type PP (SortOnDesc p q) x = PP (SortOnDescT p q) x
eval :: proxy (SortOnDesc p q)
-> POpts -> x -> m (TT (PP (SortOnDesc p q) x))
eval proxy (SortOnDesc p q)
_ = Proxy (SortOnDescT p q)
-> POpts -> x -> m (TT (PP (SortOnDescT 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 (SortOnDescT p q)
forall k (t :: k). Proxy t
Proxy @(SortOnDescT p q))
data Sort deriving Int -> Sort -> ShowS
[Sort] -> ShowS
Sort -> String
(Int -> Sort -> ShowS)
-> (Sort -> String) -> ([Sort] -> ShowS) -> Show Sort
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sort] -> ShowS
$cshowList :: [Sort] -> ShowS
show :: Sort -> String
$cshow :: Sort -> String
showsPrec :: Int -> Sort -> ShowS
$cshowsPrec :: Int -> Sort -> ShowS
Show
type SortT = SortOn Id Id
instance P SortT x => P Sort x where
type PP Sort x = PP SortT x
eval :: proxy Sort -> POpts -> x -> m (TT (PP Sort x))
eval proxy Sort
_ = Proxy SortT -> POpts -> x -> m (TT (PP SortT 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 SortT
forall k (t :: k). Proxy t
Proxy @SortT)
data Reverse deriving Int -> Reverse -> ShowS
[Reverse] -> ShowS
Reverse -> String
(Int -> Reverse -> ShowS)
-> (Reverse -> String) -> ([Reverse] -> ShowS) -> Show Reverse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reverse] -> ShowS
$cshowList :: [Reverse] -> ShowS
show :: Reverse -> String
$cshow :: Reverse -> String
showsPrec :: Int -> Reverse -> ShowS
$cshowsPrec :: Int -> Reverse -> ShowS
Show
instance ( x ~ [a]
, Show a
) => P Reverse x where
type PP Reverse x = x
eval :: proxy Reverse -> POpts -> x -> m (TT (PP Reverse x))
eval proxy Reverse
_ POpts
opts x
as =
let msg0 :: String
msg0 = String
"Reverse"
d :: [a]
d = ([a] -> a -> [a]) -> [a] -> [a] -> [a]
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) [] x
[a]
as
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] -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 [a]
d x
as) []
data ReverseL deriving Int -> ReverseL -> ShowS
[ReverseL] -> ShowS
ReverseL -> String
(Int -> ReverseL -> ShowS)
-> (ReverseL -> String) -> ([ReverseL] -> ShowS) -> Show ReverseL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReverseL] -> ShowS
$cshowList :: [ReverseL] -> ShowS
show :: ReverseL -> String
$cshow :: ReverseL -> String
showsPrec :: Int -> ReverseL -> ShowS
$cshowsPrec :: Int -> ReverseL -> ShowS
Show
instance ( Reversing t
, Show t
) => P ReverseL t where
type PP ReverseL t = t
eval :: proxy ReverseL -> POpts -> t -> m (TT (PP ReverseL t))
eval proxy ReverseL
_ POpts
opts t
as =
let msg0 :: String
msg0 = String
"ReverseL"
d :: t
d = t
as t -> Getting t t t -> t
forall s a. s -> Getting a s a -> a
^. Getting t t t
forall a. Reversing a => Iso' a a
reversed
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 -> t -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 t
d t
as) []
data Singleton p deriving Int -> Singleton p -> ShowS
[Singleton p] -> ShowS
Singleton p -> String
(Int -> Singleton p -> ShowS)
-> (Singleton p -> String)
-> ([Singleton p] -> ShowS)
-> Show (Singleton p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Singleton p -> ShowS
forall k (p :: k). [Singleton p] -> ShowS
forall k (p :: k). Singleton p -> String
showList :: [Singleton p] -> ShowS
$cshowList :: forall k (p :: k). [Singleton p] -> ShowS
show :: Singleton p -> String
$cshow :: forall k (p :: k). Singleton p -> String
showsPrec :: Int -> Singleton p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Singleton p -> ShowS
Show
instance P p x => P (Singleton p) x where
type PP (Singleton p) x = [PP p x]
eval :: proxy (Singleton p) -> POpts -> x -> m (TT (PP (Singleton p) x))
eval proxy (Singleton p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Singleton"
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 [PP p x] -> m (TT [PP p x])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [PP p x] -> m (TT [PP p x])) -> TT [PP p x] -> m (TT [PP p x])
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT [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 [PP p x]
e -> TT [PP p x]
e
Right PP p x
p -> POpts -> Val [PP p x] -> String -> [Tree PE] -> TT [PP p x]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([PP p x] -> Val [PP p x]
forall a. a -> Val a
Val [PP p x
p]) String
msg0 [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
data EmptyList' t 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
instance P (EmptyList' t) x where
type PP (EmptyList' t) x = [PP t x]
eval :: proxy (EmptyList' t) -> POpts -> x -> m (TT (PP (EmptyList' t) x))
eval proxy (EmptyList' t)
_ POpts
opts x
_ =
TT [PP t x] -> m (TT [PP t x])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [PP t x] -> m (TT [PP t x])) -> TT [PP t x] -> m (TT [PP t x])
forall a b. (a -> b) -> a -> b
$ POpts -> Val [PP t x] -> String -> [Tree PE] -> TT [PP t x]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([PP t x] -> Val [PP t x]
forall a. a -> Val a
Val []) String
"EmptyList" []
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) = EmptyList' (Hole 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))
data ZipWith p q r deriving Int -> ZipWith p q r -> ShowS
[ZipWith p q r] -> ShowS
ZipWith p q r -> String
(Int -> ZipWith p q r -> ShowS)
-> (ZipWith p q r -> String)
-> ([ZipWith p q r] -> ShowS)
-> Show (ZipWith 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 -> ZipWith p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). [ZipWith p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). ZipWith p q r -> String
showList :: [ZipWith p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k). [ZipWith p q r] -> ShowS
show :: ZipWith p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k). ZipWith p q r -> String
showsPrec :: Int -> ZipWith p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k).
Int -> ZipWith p q r -> ShowS
Show
instance ( PP q a ~ [x]
, PP r a ~ [y]
, P q a
, P r a
, P p (x,y)
, Show x
, Show y
, Show (PP p (x,y))
) => P (ZipWith p q r) a where
type PP (ZipWith p q r) a = [PP p (ExtractAFromList (PP q a), ExtractAFromList (PP r a))]
eval :: proxy (ZipWith p q r)
-> POpts -> a -> m (TT (PP (ZipWith p q r) a))
eval proxy (ZipWith p q r)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"ZipWith"
Either (TT [PP p (x, y)]) ([x], [y], TT [x], TT [y])
lr <- Inline
-> String
-> Proxy q
-> Proxy r
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT [PP p (x, y)]) (PP q a, PP r a, TT (PP q a), TT (PP r 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 q
forall k (t :: k). Proxy t
Proxy @q) (Proxy r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts a
a []
case Either (TT [PP p (x, y)]) ([x], [y], TT [x], TT [y])
lr of
Left TT [PP p (x, y)]
e -> TT [PP p (x, y)] -> m (TT [PP p (x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [PP p (x, y)]
e
Right ([x]
q,[y]
r,TT [x]
qq,TT [y]
rr) ->
let hhs :: [Tree PE]
hhs = [TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq, TT [y] -> Tree PE
forall a. TT a -> Tree PE
hh TT [y]
rr]
in case POpts
-> String
-> [x]
-> [y]
-> [Tree PE]
-> Either (TT [PP p (x, y)]) ([x], [y])
forall (t :: Type -> Type) (u :: Type -> Type) a b x.
(Foldable t, Foldable u) =>
POpts
-> String -> t a -> u b -> [Tree PE] -> Either (TT x) ([a], [b])
chkSize2 POpts
opts String
msg0 [x]
q [y]
r [Tree PE]
hhs of
Left TT [PP p (x, y)]
e -> TT [PP p (x, y)] -> m (TT [PP p (x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [PP p (x, y)]
e
Right ([x], [y])
_ -> do
let lls :: (Int, Int)
lls = ([x] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [x]
q, [y] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [y]
r)
if (Int -> Int -> Bool) -> (Int, Int) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int, Int)
lls then do
[((Int, (x, y)), TT (PP p (x, y)))]
ts <- (Int -> (x, y) -> m ((Int, (x, y)), TT (PP p (x, y))))
-> [Int] -> [(x, y)] -> m [((Int, (x, y)), TT (PP p (x, y)))]
forall (m :: Type -> Type) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (\Int
i (x
x,y
y) -> ((Int
i, (x
x,y
y)),) (TT (PP p (x, y)) -> ((Int, (x, y)), TT (PP p (x, y))))
-> m (TT (PP p (x, y))) -> m ((Int, (x, y)), TT (PP p (x, y)))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> POpts -> (x, y) -> m (TT (PP p (x, y)))
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p a) =>
POpts -> a -> m (TT (PP p a))
evalHide @p POpts
opts (x
x,y
y)) [Int
0::Int ..] ([x] -> [y] -> [(x, y)]
forall a b. [a] -> [b] -> [(a, b)]
zip [x]
q [y]
r)
TT [PP p (x, y)] -> m (TT [PP p (x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [PP p (x, y)] -> m (TT [PP p (x, y)]))
-> TT [PP p (x, y)] -> m (TT [PP p (x, y)])
forall a b. (a -> b) -> a -> b
$ case POpts
-> String
-> [((Int, (x, y)), TT (PP p (x, y)))]
-> Either
(TT [PP p (x, y)]) [(PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))]
forall x a w.
Show x =>
POpts
-> String
-> [((Int, x), TT a)]
-> Either (TT w) [(a, (Int, x), TT a)]
splitAndAlign POpts
opts String
msg0 [((Int, (x, y)), TT (PP p (x, y)))]
ts of
Left TT [PP p (x, y)]
e -> TT [PP p (x, y)]
e
Right [(PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))]
abcs ->
let kvs :: [(PP p (x, y), [(x, y)])]
kvs = ((PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
-> (PP p (x, y), [(x, y)]))
-> [(PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))]
-> [(PP p (x, y), [(x, y)])]
forall a b. (a -> b) -> [a] -> [b]
map (Getting
(PP p (x, y))
(PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
(PP p (x, y))
-> (PP p (x, y), (Int, (x, y)), TT (PP p (x, y))) -> PP p (x, y)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(PP p (x, y))
(PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
(PP p (x, y))
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((PP p (x, y), (Int, (x, y)), TT (PP p (x, y))) -> PP p (x, y))
-> ((PP p (x, y), (Int, (x, y)), TT (PP p (x, y))) -> [(x, y)])
-> (PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
-> (PP p (x, y), [(x, y)])
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (((x, y) -> [(x, y)] -> [(x, y)]
forall a. a -> [a] -> [a]
:[]) ((x, y) -> [(x, y)])
-> ((PP p (x, y), (Int, (x, y)), TT (PP p (x, y))) -> (x, y))
-> (PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
-> [(x, y)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
(x, y) (PP p (x, y), (Int, (x, y)), TT (PP p (x, y))) (x, y)
-> (PP p (x, y), (Int, (x, y)), TT (PP p (x, y))) -> (x, y)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view (((Int, (x, y)) -> Const (x, y) (Int, (x, y)))
-> (PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
-> Const (x, y) (PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
forall s t a b. Field2 s t a b => Lens s t a b
_2 (((Int, (x, y)) -> Const (x, y) (Int, (x, y)))
-> (PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
-> Const (x, y) (PP p (x, y), (Int, (x, y)), TT (PP p (x, y))))
-> (((x, y) -> Const (x, y) (x, y))
-> (Int, (x, y)) -> Const (x, y) (Int, (x, y)))
-> Getting
(x, y) (PP p (x, y), (Int, (x, y)), TT (PP p (x, y))) (x, y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((x, y) -> Const (x, y) (x, y))
-> (Int, (x, y)) -> Const (x, y) (Int, (x, y))
forall s t a b. Field2 s t a b => Lens s t a b
_2))) [(PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))]
abcs
itts :: [((Int, (x, y)), TT (PP p (x, y)))]
itts = ((PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
-> ((Int, (x, y)), TT (PP p (x, y))))
-> [(PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))]
-> [((Int, (x, y)), TT (PP p (x, y)))]
forall a b. (a -> b) -> [a] -> [b]
map (Getting
(Int, (x, y))
(PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
(Int, (x, y))
-> (PP p (x, y), (Int, (x, y)), TT (PP p (x, y))) -> (Int, (x, y))
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(Int, (x, y))
(PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
(Int, (x, y))
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((PP p (x, y), (Int, (x, y)), TT (PP p (x, y))) -> (Int, (x, y)))
-> ((PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
-> TT (PP p (x, y)))
-> (PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
-> ((Int, (x, y)), TT (PP p (x, y)))
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting
(TT (PP p (x, y)))
(PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
(TT (PP p (x, y)))
-> (PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
-> TT (PP p (x, y))
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
(TT (PP p (x, y)))
(PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))
(TT (PP p (x, y)))
forall s t a b. Field3 s t a b => Lens s t a b
_3) [(PP p (x, y), (Int, (x, y)), TT (PP p (x, y)))]
abcs
ret :: [PP p (x, y)]
ret = ((PP p (x, y), [(x, y)]) -> PP p (x, y))
-> [(PP p (x, y), [(x, y)])] -> [PP p (x, y)]
forall a b. (a -> b) -> [a] -> [b]
map (PP p (x, y), [(x, y)]) -> PP p (x, y)
forall a b. (a, b) -> a
fst [(PP p (x, y), [(x, y)])]
kvs
in POpts
-> Val [PP p (x, y)] -> String -> [Tree PE] -> TT [PP p (x, y)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([PP p (x, y)] -> Val [PP p (x, y)]
forall a. a -> Val a
Val [PP p (x, y)]
ret) (POpts -> String -> [PP p (x, y)] -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [PP p (x, y)]
ret String
"s=" [x]
q ) (TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
qq Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: (((Int, (x, y)), TT (PP p (x, y))) -> Tree PE)
-> [((Int, (x, y)), TT (PP p (x, y)))] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT (PP p (x, y)) -> Tree PE
forall a. TT a -> Tree PE
hh (TT (PP p (x, y)) -> Tree PE)
-> (((Int, (x, y)), TT (PP p (x, y))) -> TT (PP p (x, y)))
-> ((Int, (x, y)), TT (PP p (x, y)))
-> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, (x, y)), TT (PP p (x, y))) -> TT (PP p (x, y))
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) [((Int, (x, y)), TT (PP p (x, y)))]
itts)
else do
let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int, Int)
lls
TT [PP p (x, y)] -> m (TT [PP p (x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [PP p (x, y)] -> m (TT [PP p (x, y)]))
-> TT [PP p (x, y)] -> m (TT [PP p (x, y)])
forall a b. (a -> b) -> a -> b
$ POpts
-> Val [PP p (x, y)] -> String -> [Tree PE] -> TT [PP p (x, y)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val [PP p (x, y)]
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" length mismatch")) (POpts -> String -> [x] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
"q=" [x]
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [y] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | r=" [y]
r) [Tree PE]
hhs
data ZipPad l r p q deriving Int -> ZipPad l r p q -> ShowS
[ZipPad l r p q] -> ShowS
ZipPad l r p q -> String
(Int -> ZipPad l r p q -> ShowS)
-> (ZipPad l r p q -> String)
-> ([ZipPad l r p q] -> ShowS)
-> Show (ZipPad l r p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (l :: k) k (r :: k) k (p :: k) k (q :: k).
Int -> ZipPad l r p q -> ShowS
forall k (l :: k) k (r :: k) k (p :: k) k (q :: k).
[ZipPad l r p q] -> ShowS
forall k (l :: k) k (r :: k) k (p :: k) k (q :: k).
ZipPad l r p q -> String
showList :: [ZipPad l r p q] -> ShowS
$cshowList :: forall k (l :: k) k (r :: k) k (p :: k) k (q :: k).
[ZipPad l r p q] -> ShowS
show :: ZipPad l r p q -> String
$cshow :: forall k (l :: k) k (r :: k) k (p :: k) k (q :: k).
ZipPad l r p q -> String
showsPrec :: Int -> ZipPad l r p q -> ShowS
$cshowsPrec :: forall k (l :: k) k (r :: k) k (p :: k) k (q :: k).
Int -> ZipPad l r p q -> ShowS
Show
instance ( PP l a ~ x
, PP r a ~ y
, P l a
, P r a
, PP p a ~ [x]
, PP q a ~ [y]
, P p a
, P q a
, Show x
, Show y
) => P (ZipPad l r p q) a where
type PP (ZipPad l r p q) a = [(PP l a, PP r a)]
eval :: proxy (ZipPad l r p q)
-> POpts -> a -> m (TT (PP (ZipPad l r p q) a))
eval proxy (ZipPad l r p q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"ZipPad"
Either (TT [(x, y)]) ([x], [y], TT [x], TT [y])
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT [(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 []
case Either (TT [(x, y)]) ([x], [y], TT [x], TT [y])
lr of
Left TT [(x, y)]
e -> TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [(x, y)]
e
Right ([x]
p,[y]
q,TT [x]
pp,TT [y]
qq) -> do
let hhs :: [Tree PE]
hhs = [TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
pp, TT [y] -> Tree PE
forall a. TT a -> Tree PE
hh TT [y]
qq]
case POpts
-> String
-> [x]
-> [y]
-> [Tree PE]
-> Either (TT [(x, y)]) ([x], [y])
forall (t :: Type -> Type) (u :: Type -> Type) a b x.
(Foldable t, Foldable u) =>
POpts
-> String -> t a -> u b -> [Tree PE] -> Either (TT x) ([a], [b])
chkSize2 POpts
opts String
msg0 [x]
p [y]
q [Tree PE]
hhs of
Left TT [(x, y)]
e -> TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [(x, y)]
e
Right ([x], [y])
_ ->
case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([x] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [x]
p) ([y] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [y]
q) of
Ordering
LT -> do
TT x
ll <- Proxy l -> POpts -> a -> m (TT (PP l 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 l
forall k (t :: k). Proxy t
Proxy @l) POpts
opts a
a
TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(x, y)] -> m (TT [(x, y)])) -> TT [(x, y)] -> m (TT [(x, y)])
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT x -> [Tree PE] -> Either (TT [(x, y)]) 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
" l failed") TT x
ll [Tree PE]
hhs of
Left TT [(x, y)]
e -> TT [(x, y)]
e
Right x
l ->
let d :: [(x, y)]
d = [x] -> [y] -> [(x, y)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([x]
p [x] -> [x] -> [x]
forall a. [a] -> [a] -> [a]
++ x -> [x]
forall a. a -> [a]
repeat x
l) [y]
q
in POpts -> Val [(x, y)] -> String -> [Tree PE] -> TT [(x, y)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(x, y)] -> Val [(x, y)]
forall a. a -> Val a
Val [(x, y)]
d) (POpts -> String -> [(x, y)] -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Left pad") [(x, y)]
d String
"p=" [x]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [y] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [y]
q) ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT x -> Tree PE
forall a. TT a -> Tree PE
hh TT x
ll])
Ordering
GT -> do
TT y
rr <- Proxy r -> POpts -> a -> m (TT (PP r 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 r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts a
a
TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(x, y)] -> m (TT [(x, y)])) -> TT [(x, y)] -> m (TT [(x, y)])
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT y -> [Tree PE] -> Either (TT [(x, y)]) y
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
" r failed") TT y
rr [Tree PE]
hhs of
Left TT [(x, y)]
e -> TT [(x, y)]
e
Right y
r ->
let d :: [(x, y)]
d =[x] -> [y] -> [(x, y)]
forall a b. [a] -> [b] -> [(a, b)]
zip [x]
p ([y]
q [y] -> [y] -> [y]
forall a. [a] -> [a] -> [a]
++ y -> [y]
forall a. a -> [a]
repeat y
r)
in POpts -> Val [(x, y)] -> String -> [Tree PE] -> TT [(x, y)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(x, y)] -> Val [(x, y)]
forall a. a -> Val a
Val [(x, y)]
d) (POpts -> String -> [(x, y)] -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" Right pad") [(x, y)]
d String
"p=" [x]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [y] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [y]
q) ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT y -> Tree PE
forall a. TT a -> Tree PE
hh TT y
rr])
Ordering
EQ ->
let d :: [(x, y)]
d = [x] -> [y] -> [(x, y)]
forall a b. [a] -> [b] -> [(a, b)]
zip [x]
p [y]
q
in TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(x, y)] -> m (TT [(x, y)])) -> TT [(x, y)] -> m (TT [(x, y)])
forall a b. (a -> b) -> a -> b
$ POpts -> Val [(x, y)] -> String -> [Tree PE] -> TT [(x, y)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(x, y)] -> Val [(x, y)]
forall a. a -> Val a
Val [(x, y)]
d) (POpts -> String -> [(x, y)] -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" No pad") [(x, y)]
d String
"p=" [x]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [y] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [y]
q) [Tree PE]
hhs
data ZipL l p q deriving Int -> ZipL l p q -> ShowS
[ZipL l p q] -> ShowS
ZipL l p q -> String
(Int -> ZipL l p q -> ShowS)
-> (ZipL l p q -> String)
-> ([ZipL l p q] -> ShowS)
-> Show (ZipL l p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (l :: k) k (p :: k) k (q :: k). Int -> ZipL l p q -> ShowS
forall k (l :: k) k (p :: k) k (q :: k). [ZipL l p q] -> ShowS
forall k (l :: k) k (p :: k) k (q :: k). ZipL l p q -> String
showList :: [ZipL l p q] -> ShowS
$cshowList :: forall k (l :: k) k (p :: k) k (q :: k). [ZipL l p q] -> ShowS
show :: ZipL l p q -> String
$cshow :: forall k (l :: k) k (p :: k) k (q :: k). ZipL l p q -> String
showsPrec :: Int -> ZipL l p q -> ShowS
$cshowsPrec :: forall k (l :: k) k (p :: k) k (q :: k). Int -> ZipL l p q -> ShowS
Show
instance ( PP l a ~ x
, P l a
, PP p a ~ [x]
, PP q a ~ [y]
, P p a
, P q a
, Show x
, Show y
) => P (ZipL l p q) a where
type PP (ZipL l p q) a = [(ExtractAFromList (PP p a), ExtractAFromList (PP q a))]
eval :: proxy (ZipL l p q) -> POpts -> a -> m (TT (PP (ZipL l p q) a))
eval proxy (ZipL l p q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"ZipL"
Either (TT [(x, y)]) ([x], [y], TT [x], TT [y])
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT [(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 []
case Either (TT [(x, y)]) ([x], [y], TT [x], TT [y])
lr of
Left TT [(x, y)]
e -> TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [(x, y)]
e
Right ([x]
p,[y]
q,TT [x]
pp,TT [y]
qq) -> do
let hhs :: [Tree PE]
hhs = [TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
pp, TT [y] -> Tree PE
forall a. TT a -> Tree PE
hh TT [y]
qq]
case POpts
-> String
-> [x]
-> [y]
-> [Tree PE]
-> Either (TT [(x, y)]) ([x], [y])
forall (t :: Type -> Type) (u :: Type -> Type) a b x.
(Foldable t, Foldable u) =>
POpts
-> String -> t a -> u b -> [Tree PE] -> Either (TT x) ([a], [b])
chkSize2 POpts
opts String
msg0 [x]
p [y]
q [Tree PE]
hhs of
Left TT [(x, y)]
e -> TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [(x, y)]
e
Right ([x], [y])
_ -> do
let lls :: (Int, Int)
lls = ([x] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [x]
p,[y] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [y]
q)
case (Int -> Int -> Ordering) -> (Int, Int) -> Ordering
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int, Int)
lls of
Ordering
GT -> let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int, Int)
lls
in TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(x, y)] -> m (TT [(x, y)])) -> TT [(x, y)] -> m (TT [(x, y)])
forall a b. (a -> b) -> a -> b
$ POpts -> Val [(x, y)] -> String -> [Tree PE] -> TT [(x, y)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val [(x, y)]
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" rhs would be truncated")) (POpts -> String -> [x] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
"p=" [x]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [y] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [y]
q) [Tree PE]
hhs
Ordering
_ -> do
TT x
ll <- Proxy l -> POpts -> a -> m (TT (PP l 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 l
forall k (t :: k). Proxy t
Proxy @l) POpts
opts a
a
TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(x, y)] -> m (TT [(x, y)])) -> TT [(x, y)] -> m (TT [(x, y)])
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT x -> [Tree PE] -> Either (TT [(x, y)]) 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
" l failed") TT x
ll [Tree PE]
hhs of
Left TT [(x, y)]
e -> TT [(x, y)]
e
Right x
l ->
let d :: [(x, y)]
d = [x] -> [y] -> [(x, y)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([x]
p [x] -> [x] -> [x]
forall a. [a] -> [a] -> [a]
++ x -> [x]
forall a. a -> [a]
repeat x
l) [y]
q
in POpts -> Val [(x, y)] -> String -> [Tree PE] -> TT [(x, y)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(x, y)] -> Val [(x, y)]
forall a. a -> Val a
Val [(x, y)]
d) (POpts -> String -> [(x, y)] -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [(x, y)]
d String
"p=" [x]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [y] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [y]
q) ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT x -> Tree PE
forall a. TT a -> Tree PE
hh TT x
ll])
data ZipR r p q deriving Int -> ZipR r p q -> ShowS
[ZipR r p q] -> ShowS
ZipR r p q -> String
(Int -> ZipR r p q -> ShowS)
-> (ZipR r p q -> String)
-> ([ZipR r p q] -> ShowS)
-> Show (ZipR r p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (r :: k) k (p :: k) k (q :: k). Int -> ZipR r p q -> ShowS
forall k (r :: k) k (p :: k) k (q :: k). [ZipR r p q] -> ShowS
forall k (r :: k) k (p :: k) k (q :: k). ZipR r p q -> String
showList :: [ZipR r p q] -> ShowS
$cshowList :: forall k (r :: k) k (p :: k) k (q :: k). [ZipR r p q] -> ShowS
show :: ZipR r p q -> String
$cshow :: forall k (r :: k) k (p :: k) k (q :: k). ZipR r p q -> String
showsPrec :: Int -> ZipR r p q -> ShowS
$cshowsPrec :: forall k (r :: k) k (p :: k) k (q :: k). Int -> ZipR r p q -> ShowS
Show
instance ( PP r a ~ y
, P r a
, PP p a ~ [x]
, PP q a ~ [y]
, P p a
, P q a
, Show x
, Show y
) => P (ZipR r p q) a where
type PP (ZipR r p q) a = [(ExtractAFromList (PP p a), ExtractAFromList (PP q a))]
eval :: proxy (ZipR r p q) -> POpts -> a -> m (TT (PP (ZipR r p q) a))
eval proxy (ZipR r p q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"ZipR"
Either (TT [(x, y)]) ([x], [y], TT [x], TT [y])
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT [(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 []
case Either (TT [(x, y)]) ([x], [y], TT [x], TT [y])
lr of
Left TT [(x, y)]
e -> TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [(x, y)]
e
Right ([x]
p,[y]
q,TT [x]
pp,TT [y]
qq) -> do
let hhs :: [Tree PE]
hhs = [TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
pp, TT [y] -> Tree PE
forall a. TT a -> Tree PE
hh TT [y]
qq]
case POpts
-> String
-> [x]
-> [y]
-> [Tree PE]
-> Either (TT [(x, y)]) ([x], [y])
forall (t :: Type -> Type) (u :: Type -> Type) a b x.
(Foldable t, Foldable u) =>
POpts
-> String -> t a -> u b -> [Tree PE] -> Either (TT x) ([a], [b])
chkSize2 POpts
opts String
msg0 [x]
p [y]
q [Tree PE]
hhs of
Left TT [(x, y)]
e -> TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [(x, y)]
e
Right ([x], [y])
_ -> do
let lls :: (Int, Int)
lls = ([x] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [x]
p,[y] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [y]
q)
case (Int -> Int -> Ordering) -> (Int, Int) -> Ordering
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int, Int)
lls of
Ordering
LT -> let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int, Int)
lls
in TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(x, y)] -> m (TT [(x, y)])) -> TT [(x, y)] -> m (TT [(x, y)])
forall a b. (a -> b) -> a -> b
$ POpts -> Val [(x, y)] -> String -> [Tree PE] -> TT [(x, y)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val [(x, y)]
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" rhs would be truncated")) (POpts -> String -> [x] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
"p=" [x]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [y] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [y]
q) [Tree PE]
hhs
Ordering
_ -> do
TT y
rr <- Proxy r -> POpts -> a -> m (TT (PP r 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 r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts a
a
TT [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(x, y)] -> m (TT [(x, y)])) -> TT [(x, y)] -> m (TT [(x, y)])
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT y -> [Tree PE] -> Either (TT [(x, y)]) y
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
" l failed") TT y
rr [Tree PE]
hhs of
Left TT [(x, y)]
e -> TT [(x, y)]
e
Right y
r ->
let d :: [(x, y)]
d = [x] -> [y] -> [(x, y)]
forall a b. [a] -> [b] -> [(a, b)]
zip [x]
p ([y]
q [y] -> [y] -> [y]
forall a. [a] -> [a] -> [a]
++ y -> [y]
forall a. a -> [a]
repeat y
r)
in POpts -> Val [(x, y)] -> String -> [Tree PE] -> TT [(x, y)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(x, y)] -> Val [(x, y)]
forall a. a -> Val a
Val [(x, y)]
d) (POpts -> String -> [(x, y)] -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [(x, y)]
d String
"p=" [x]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [y] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [y]
q) ([Tree PE]
hhs [Tree PE] -> [Tree PE] -> [Tree PE]
forall a. [a] -> [a] -> [a]
++ [TT y -> Tree PE
forall a. TT a -> Tree PE
hh TT y
rr])
data Zip p q deriving Int -> Zip p q -> ShowS
[Zip p q] -> ShowS
Zip p q -> String
(Int -> Zip p q -> ShowS)
-> (Zip p q -> String) -> ([Zip p q] -> ShowS) -> Show (Zip p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Zip p q -> ShowS
forall k (p :: k) k (q :: k). [Zip p q] -> ShowS
forall k (p :: k) k (q :: k). Zip p q -> String
showList :: [Zip p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Zip p q] -> ShowS
show :: Zip p q -> String
$cshow :: forall k (p :: k) k (q :: k). Zip p q -> String
showsPrec :: Int -> Zip p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Zip p q -> ShowS
Show
instance ( PP p a ~ [x]
, PP q a ~ [y]
, P p a
, P q a
, Show x
, Show y
) => P (Zip p q) a where
type PP (Zip p q) a = [(ExtractAFromList (PP p a), ExtractAFromList (PP q a))]
eval :: proxy (Zip p q) -> POpts -> a -> m (TT (PP (Zip p q) a))
eval proxy (Zip p q)
_ POpts
opts a
a = do
let msg0 :: String
msg0 = String
"Zip"
Either (TT [(x, y)]) ([x], [y], TT [x], TT [y])
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
(TT [(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 [(x, y)] -> m (TT [(x, y)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(x, y)] -> m (TT [(x, y)])) -> TT [(x, y)] -> m (TT [(x, y)])
forall a b. (a -> b) -> a -> b
$ case Either (TT [(x, y)]) ([x], [y], TT [x], TT [y])
lr of
Left TT [(x, y)]
e -> TT [(x, y)]
e
Right ([x]
p,[y]
q,TT [x]
pp,TT [y]
qq) ->
let hhs :: [Tree PE]
hhs = [TT [x] -> Tree PE
forall a. TT a -> Tree PE
hh TT [x]
pp, TT [y] -> Tree PE
forall a. TT a -> Tree PE
hh TT [y]
qq]
in case POpts
-> String
-> [x]
-> [y]
-> [Tree PE]
-> Either (TT [(x, y)]) ([x], [y])
forall (t :: Type -> Type) (u :: Type -> Type) a b x.
(Foldable t, Foldable u) =>
POpts
-> String -> t a -> u b -> [Tree PE] -> Either (TT x) ([a], [b])
chkSize2 POpts
opts String
msg0 [x]
p [y]
q [Tree PE]
hhs of
Left TT [(x, y)]
e -> TT [(x, y)]
e
Right ([x], [y])
_ ->
let lls :: (Int, Int)
lls = ([x] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [x]
p, [y] -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length [y]
q)
in case (Int -> Int -> Ordering) -> (Int, Int) -> Ordering
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int, Int)
lls of
Ordering
EQ -> let d :: [(x, y)]
d = [x] -> [y] -> [(x, y)]
forall a b. [a] -> [b] -> [(a, b)]
zip [x]
p [y]
q
in POpts -> Val [(x, y)] -> String -> [Tree PE] -> TT [(x, y)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(x, y)] -> Val [(x, y)]
forall a. a -> Val a
Val [(x, y)]
d) (POpts -> String -> [(x, y)] -> String -> [x] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [(x, y)]
d String
"p=" [x]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [y] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [y]
q) [Tree PE]
hhs
Ordering
_ -> let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int, Int)
lls
in POpts -> Val [(x, y)] -> String -> [Tree PE] -> TT [(x, y)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val [(x, y)]
forall a. String -> Val a
Fail (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" length mismatch")) (POpts -> String -> [x] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
"p=" [x]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [y] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [y]
q) [Tree PE]
hhs
data EmptyT (t :: Type -> Type) deriving Int -> EmptyT t -> ShowS
[EmptyT t] -> ShowS
EmptyT t -> String
(Int -> EmptyT t -> ShowS)
-> (EmptyT t -> String) -> ([EmptyT t] -> ShowS) -> Show (EmptyT t)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: Type -> Type). Int -> EmptyT t -> ShowS
forall (t :: Type -> Type). [EmptyT t] -> ShowS
forall (t :: Type -> Type). EmptyT t -> String
showList :: [EmptyT t] -> ShowS
$cshowList :: forall (t :: Type -> Type). [EmptyT t] -> ShowS
show :: EmptyT t -> String
$cshow :: forall (t :: Type -> Type). EmptyT t -> String
showsPrec :: Int -> EmptyT t -> ShowS
$cshowsPrec :: forall (t :: Type -> Type). Int -> EmptyT t -> ShowS
Show
instance Alternative t => P (EmptyT t) x where
type PP (EmptyT t) x = t x
eval :: proxy (EmptyT t) -> POpts -> x -> m (TT (PP (EmptyT t) x))
eval proxy (EmptyT t)
_ POpts
opts x
_ =
let msg0 :: String
msg0 = String
"EmptyT"
b :: t x
b = forall a. Alternative t => t a
forall (f :: Type -> Type) a. Alternative f => f a
empty @t
in 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
b) String
msg0 []
data Sum deriving Int -> Sum -> ShowS
[Sum] -> ShowS
Sum -> String
(Int -> Sum -> ShowS)
-> (Sum -> String) -> ([Sum] -> ShowS) -> Show Sum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sum] -> ShowS
$cshowList :: [Sum] -> ShowS
show :: Sum -> String
$cshow :: Sum -> String
showsPrec :: Int -> Sum -> ShowS
$cshowsPrec :: Int -> Sum -> ShowS
Show
instance ( x ~ [a]
, Num a
, Show a
) => P Sum x where
type PP Sum x = ExtractAFromTA x
eval :: proxy Sum -> POpts -> x -> m (TT (PP Sum x))
eval proxy Sum
_ POpts
opts x
as =
let msg0 :: String
msg0 = String
"Sum"
v :: a
v = [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
sum' x
[a]
as
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
v) (POpts -> String -> a -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 a
v x
as) []
data Product deriving Int -> Product -> ShowS
[Product] -> ShowS
Product -> String
(Int -> Product -> ShowS)
-> (Product -> String) -> ([Product] -> ShowS) -> Show Product
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Product] -> ShowS
$cshowList :: [Product] -> ShowS
show :: Product -> String
$cshow :: Product -> String
showsPrec :: Int -> Product -> ShowS
$cshowsPrec :: Int -> Product -> ShowS
Show
instance ( x ~ [a]
, Num a
, Show a
) => P Product x where
type PP Product x = ExtractAFromTA x
eval :: proxy Product -> POpts -> x -> m (TT (PP Product x))
eval proxy Product
_ POpts
opts x
as =
let msg0 :: String
msg0 = String
"Product"
v :: a
v = [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Num a) => t a -> a
product' x
[a]
as
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
v) (POpts -> String -> a -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 a
v x
as) []
data Min deriving Int -> Min -> ShowS
[Min] -> ShowS
Min -> String
(Int -> Min -> ShowS)
-> (Min -> String) -> ([Min] -> ShowS) -> Show Min
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Min] -> ShowS
$cshowList :: [Min] -> ShowS
show :: Min -> String
$cshow :: Min -> String
showsPrec :: Int -> Min -> ShowS
$cshowsPrec :: Int -> Min -> ShowS
Show
instance ( x ~ [a]
, Ord a
, Show a
) => P Min x where
type PP Min x = ExtractAFromTA x
eval :: proxy Min -> POpts -> x -> m (TT (PP Min x))
eval proxy Min
_ POpts
opts x
as' = do
let msg0 :: String
msg0 = String
"Min"
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 x
as' of
[] -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail String
"empty list") String
msg0 []
xs :: x
xs@(a:as) ->
let v :: a
v = (a -> a -> a) -> a -> [a] -> a
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Ord a => a -> a -> a
min a
a [a]
as
in 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
v) (POpts -> String -> a -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 a
v x
xs) []
data Max deriving Int -> Max -> ShowS
[Max] -> ShowS
Max -> String
(Int -> Max -> ShowS)
-> (Max -> String) -> ([Max] -> ShowS) -> Show Max
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Max] -> ShowS
$cshowList :: [Max] -> ShowS
show :: Max -> String
$cshow :: Max -> String
showsPrec :: Int -> Max -> ShowS
$cshowsPrec :: Int -> Max -> ShowS
Show
instance ( x ~ [a]
, Ord a
, Show a
) => P Max x where
type PP Max x = ExtractAFromTA x
eval :: proxy Max -> POpts -> x -> m (TT (PP Max x))
eval proxy Max
_ POpts
opts x
as' = do
let msg0 :: String
msg0 = String
"Max"
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 x
as' of
[] -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail String
"empty list") String
msg0 []
xs :: x
xs@(a:as) ->
let v :: a
v = (a -> a -> a) -> a -> [a] -> a
forall (t :: Type -> Type) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Ord a => a -> a -> a
max a
a [a]
as
in 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
v) (POpts -> String -> a -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 a
v x
xs) []
data IsFixImpl (cmp :: Ordering) p q deriving Int -> IsFixImpl cmp p q -> ShowS
[IsFixImpl cmp p q] -> ShowS
IsFixImpl cmp p q -> String
(Int -> IsFixImpl cmp p q -> ShowS)
-> (IsFixImpl cmp p q -> String)
-> ([IsFixImpl cmp p q] -> ShowS)
-> Show (IsFixImpl cmp p q)
forall (cmp :: Ordering) k (p :: k) k (q :: k).
Int -> IsFixImpl cmp p q -> ShowS
forall (cmp :: Ordering) k (p :: k) k (q :: k).
[IsFixImpl cmp p q] -> ShowS
forall (cmp :: Ordering) k (p :: k) k (q :: k).
IsFixImpl cmp p q -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsFixImpl cmp p q] -> ShowS
$cshowList :: forall (cmp :: Ordering) k (p :: k) k (q :: k).
[IsFixImpl cmp p q] -> ShowS
show :: IsFixImpl cmp p q -> String
$cshow :: forall (cmp :: Ordering) k (p :: k) k (q :: k).
IsFixImpl cmp p q -> String
showsPrec :: Int -> IsFixImpl cmp p q -> ShowS
$cshowsPrec :: forall (cmp :: Ordering) k (p :: k) k (q :: k).
Int -> IsFixImpl cmp p q -> ShowS
Show
instance ( P p x
, P q x
, Show a
, Eq a
, PP p x ~ [a]
, PP q x ~ [a]
, GetOrdering cmp
) => P (IsFixImpl cmp p q) x where
type PP (IsFixImpl cmp p q) x = Bool
eval :: proxy (IsFixImpl cmp p q)
-> POpts -> x -> m (TT (PP (IsFixImpl cmp p q) x))
eval proxy (IsFixImpl cmp p q)
_ POpts
opts x
x = do
let cmp :: Ordering
cmp = GetOrdering cmp => Ordering
forall (cmp :: Ordering). GetOrdering cmp => Ordering
getOrdering @cmp
([a] -> [a] -> Bool
ff,String
msg0) = Ordering -> ([a] -> [a] -> Bool, String)
forall a. Eq a => Ordering -> ([a] -> [a] -> Bool, String)
cmpOf Ordering
cmp
Either (TT Bool) ([a], [a], TT [a], TT [a])
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT Bool) (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 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 Either (TT Bool) ([a], [a], TT [a], TT [a])
lr of
Left TT Bool
e -> TT Bool
e
Right ([a]
p,[a]
q,TT [a]
pp,TT [a]
qq) ->
let msg1 :: String
msg1 = 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]
p
in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts ([a] -> [a] -> Bool
ff [a]
p [a]
q) (String
msg1 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) [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
pp, TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
qq]
data IsPrefix p q deriving Int -> IsPrefix p q -> ShowS
[IsPrefix p q] -> ShowS
IsPrefix p q -> String
(Int -> IsPrefix p q -> ShowS)
-> (IsPrefix p q -> String)
-> ([IsPrefix p q] -> ShowS)
-> Show (IsPrefix p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> IsPrefix p q -> ShowS
forall k (p :: k) k (q :: k). [IsPrefix p q] -> ShowS
forall k (p :: k) k (q :: k). IsPrefix p q -> String
showList :: [IsPrefix p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [IsPrefix p q] -> ShowS
show :: IsPrefix p q -> String
$cshow :: forall k (p :: k) k (q :: k). IsPrefix p q -> String
showsPrec :: Int -> IsPrefix p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> IsPrefix p q -> ShowS
Show
type IsPrefixT p q = IsFixImpl 'LT p q
instance P (IsPrefixT p q) x => P (IsPrefix p q) x where
type PP (IsPrefix p q) x = PP (IsPrefixT p q) x
eval :: proxy (IsPrefix p q) -> POpts -> x -> m (TT (PP (IsPrefix p q) x))
eval proxy (IsPrefix p q)
_ = Proxy (IsPrefixT p q)
-> POpts -> x -> m (TT (PP (IsPrefixT 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 (IsPrefixT p q)
forall k (t :: k). Proxy t
Proxy @(IsPrefixT p q))
data IsInfix p q deriving Int -> IsInfix p q -> ShowS
[IsInfix p q] -> ShowS
IsInfix p q -> String
(Int -> IsInfix p q -> ShowS)
-> (IsInfix p q -> String)
-> ([IsInfix p q] -> ShowS)
-> Show (IsInfix p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> IsInfix p q -> ShowS
forall k (p :: k) k (q :: k). [IsInfix p q] -> ShowS
forall k (p :: k) k (q :: k). IsInfix p q -> String
showList :: [IsInfix p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [IsInfix p q] -> ShowS
show :: IsInfix p q -> String
$cshow :: forall k (p :: k) k (q :: k). IsInfix p q -> String
showsPrec :: Int -> IsInfix p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> IsInfix p q -> ShowS
Show
type IsInfixT p q = IsFixImpl 'EQ p q
instance P (IsInfixT p q) x => P (IsInfix p q) x where
type PP (IsInfix p q) x = PP (IsInfixT p q) x
eval :: proxy (IsInfix p q) -> POpts -> x -> m (TT (PP (IsInfix p q) x))
eval proxy (IsInfix p q)
_ = Proxy (IsInfixT p q) -> POpts -> x -> m (TT (PP (IsInfixT 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 (IsInfixT p q)
forall k (t :: k). Proxy t
Proxy @(IsInfixT p q))
data IsSuffix p q deriving Int -> IsSuffix p q -> ShowS
[IsSuffix p q] -> ShowS
IsSuffix p q -> String
(Int -> IsSuffix p q -> ShowS)
-> (IsSuffix p q -> String)
-> ([IsSuffix p q] -> ShowS)
-> Show (IsSuffix p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> IsSuffix p q -> ShowS
forall k (p :: k) k (q :: k). [IsSuffix p q] -> ShowS
forall k (p :: k) k (q :: k). IsSuffix p q -> String
showList :: [IsSuffix p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [IsSuffix p q] -> ShowS
show :: IsSuffix p q -> String
$cshow :: forall k (p :: k) k (q :: k). IsSuffix p q -> String
showsPrec :: Int -> IsSuffix p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> IsSuffix p q -> ShowS
Show
type IsSuffixT p q = IsFixImpl 'GT p q
instance P (IsSuffixT p q) x => P (IsSuffix p q) x where
type PP (IsSuffix p q) x = PP (IsSuffixT p q) x
eval :: proxy (IsSuffix p q) -> POpts -> x -> m (TT (PP (IsSuffix p q) x))
eval proxy (IsSuffix p q)
_ = Proxy (IsSuffixT p q)
-> POpts -> x -> m (TT (PP (IsSuffixT 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 (IsSuffixT p q)
forall k (t :: k). Proxy t
Proxy @(IsSuffixT p q))
data Nub deriving Int -> Nub -> ShowS
[Nub] -> ShowS
Nub -> String
(Int -> Nub -> ShowS)
-> (Nub -> String) -> ([Nub] -> ShowS) -> Show Nub
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nub] -> ShowS
$cshowList :: [Nub] -> ShowS
show :: Nub -> String
$cshow :: Nub -> String
showsPrec :: Int -> Nub -> ShowS
$cshowsPrec :: Int -> Nub -> ShowS
Show
instance ( x ~ [a]
, Show a
, Ord a
) => P Nub x where
type PP Nub x = x
eval :: proxy Nub -> POpts -> x -> m (TT (PP Nub x))
eval proxy Nub
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"Nub"
ret :: [a]
ret = [a] -> [a]
forall a. Ord a => [a] -> [a]
nubOrd x
[a]
x
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]
ret) (POpts -> String -> [a] -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 [a]
ret x
x) []
data ZipCartesian p q deriving Int -> ZipCartesian p q -> ShowS
[ZipCartesian p q] -> ShowS
ZipCartesian p q -> String
(Int -> ZipCartesian p q -> ShowS)
-> (ZipCartesian p q -> String)
-> ([ZipCartesian p q] -> ShowS)
-> Show (ZipCartesian p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> ZipCartesian p q -> ShowS
forall k (p :: k) k (q :: k). [ZipCartesian p q] -> ShowS
forall k (p :: k) k (q :: k). ZipCartesian p q -> String
showList :: [ZipCartesian p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [ZipCartesian p q] -> ShowS
show :: ZipCartesian p q -> String
$cshow :: forall k (p :: k) k (q :: k). ZipCartesian p q -> String
showsPrec :: Int -> ZipCartesian p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> ZipCartesian p q -> ShowS
Show
instance ( PP p x ~ [a]
, PP q x ~ [b]
, P p x
, P q x
, Show a
, Show b
) => P (ZipCartesian p q) x where
type PP (ZipCartesian p q) x = [(ExtractAFromTA (PP p x), ExtractAFromTA (PP q x))]
eval :: proxy (ZipCartesian p q)
-> POpts -> x -> m (TT (PP (ZipCartesian p q) x))
eval proxy (ZipCartesian p q)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"ZipCartesian"
Either (TT [(a, b)]) ([a], [b], TT [a], TT [b])
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
(TT [(a, 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 [(a, b)] -> m (TT [(a, b)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(a, b)] -> m (TT [(a, b)])) -> TT [(a, b)] -> m (TT [(a, b)])
forall a b. (a -> b) -> a -> b
$ case Either (TT [(a, b)]) ([a], [b], TT [a], TT [b])
lr of
Left TT [(a, b)]
e -> TT [(a, b)]
e
Right ([a]
p,[b]
q,TT [a]
pp,TT [b]
qq) ->
let hhs :: [Tree PE]
hhs = [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
pp, TT [b] -> Tree PE
forall a. TT a -> Tree PE
hh TT [b]
qq]
in case POpts
-> String
-> [a]
-> [b]
-> [Tree PE]
-> Either (TT [(a, b)]) ([a], [b])
forall (t :: Type -> Type) (u :: Type -> Type) a b x.
(Foldable t, Foldable u) =>
POpts
-> String -> t a -> u b -> [Tree PE] -> Either (TT x) ([a], [b])
chkSize2 POpts
opts String
msg0 [a]
p [b]
q [Tree PE]
hhs of
Left TT [(a, b)]
e -> TT [(a, b)]
e
Right ([a], [b])
_ ->
let d :: [(a, b)]
d = (a -> b -> (a, b)) -> [a] -> [b] -> [(a, b)]
forall (f :: Type -> Type) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) [a]
p [b]
q
in POpts -> Val [(a, b)] -> String -> [Tree PE] -> TT [(a, b)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(a, b)] -> Val [(a, b)]
forall a. a -> Val a
Val [(a, b)]
d) (POpts -> String -> [(a, b)] -> String -> [a] -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [(a, b)]
d String
"p=" [a]
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [b] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | q=" [b]
q) [Tree PE]
hhs