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

module Predicate.Data.List (

 -- ** constructors

    type (:+)
  , type (+:)
  , type (++)
  , Singleton

 -- ** destructors

  , Uncons
  , Unsnoc
  , Head
  , Tail
  , Init
  , Last

 -- ** sort

  , SortBy
  , SortOn
  , SortOnDesc
  , Sort

 -- ** zip related

  , Unzip
  , Unzip3
  , ZipL
  , ZipR
  , Zip
  , ZipWith
  , ZipPad

 -- ** higher order methods

  , Partition
  , Quant
  , All1
  , PartitionBy
  , Group
  , GroupBy
  , GroupCnt
  , GroupCntStable
  , Filter
  , Break
  , Span
  , Intercalate
  , PartitionsBy
  , IMap
  , IList

 -- ** miscellaneous

  , 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 (==), Comparing, type (>))
import Predicate.Data.Numeric (Mod, type (-))
import Predicate.Data.Enum (type (...))
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.Foldable (toList)
import Control.Arrow (Arrow((***), (&&&)))
import qualified Data.Sequence as Seq
import Data.Bool (bool)
import qualified Data.Map.Strict as M
import Data.Containers.ListUtils (nubOrd)
import qualified Data.List.NonEmpty as NE
-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XOverloadedStrings

-- >>> :set -XNoOverloadedLists

-- >>> import qualified Data.Map.Strict as M

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

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

-- >>> import Data.These

-- >>> import Predicate


-- | similar to (++)

--

-- >>> pz @(Fst ++ Snd) ([9,10,11],[1,2,3,4])

-- Val [9,10,11,1,2,3,4]

--

-- >>> pz @(Snd ++ Fst) ([],[5])

-- Val [5]

--

-- >>> pz @(C "xyz" :+ W "ab" ++ W "cdefg") ()

-- Val "xabcdefg"

--

-- >>> pz @([1,2,3] ++ EmptyList _) "somestuff"

-- Val [1,2,3]

--

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



-- cant directly create a singleton type using '[] since the type of '[] is unknown. instead use 'Singleton' or 'EmptyT'


-- | similar to cons

--

-- >>> pz @(Fst :+ Snd) (99,[1,2,3,4])

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

--

-- >>> pz @(Snd :+ Fst) ([],5)

-- Val [5]

--

-- >>> pz @(123 :+ EmptyList _) "somestuff"

-- Val [123]

--

-- >>> pl @(Flip (:+) Fst Snd) ([1..5],99)

-- Present [99,1,2,3,4,5] ((:+) [99,1,2,3,4,5] | p=99 | q=[1,2,3,4,5])

-- Val [99,1,2,3,4,5]

--

-- >>> pl @(Fst :+ Snd) (99,[1..5])

-- Present [99,1,2,3,4,5] ((:+) [99,1,2,3,4,5] | p=99 | q=[1,2,3,4,5])

-- Val [99,1,2,3,4,5]

--

-- >>> pl @(4 :+ '[1,2,3]) ()

-- Present [4,1,2,3] ((:+) [4,1,2,3] | p=4 | q=[1,2,3])

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

--

-- >>> pl @(Fst :+ Snd) (4,[1,2,3])

-- Present [4,1,2,3] ((:+) [4,1,2,3] | p=4 | q=[1,2,3])

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

--

-- >>> pl @(Flip (:+) '[1,2,3] 5) ()

-- Present [5,1,2,3] ((:+) [5,1,2,3] | p=5 | q=[1,2,3])

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

--

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

-- | similar to snoc

--

-- >>> pz @(Snd +: Fst) (99,[1,2,3,4])

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

--

-- >>> pz @(Fst +: Snd) ([],5)

-- Val [5]

--

-- >>> pz @(EmptyT [] _ +: 5) 5

-- Val [5]

--

-- >>> pl @('[1,2,3] +: 4) ()

-- Present [1,2,3,4] ((+:) [1,2,3,4] | p=[1,2,3] | q=4)

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

--

-- >>> pl @(Snd +: Fst) (4,[1,2,3])

-- Present [1,2,3,4] ((+:) [1,2,3,4] | p=[1,2,3] | q=4)

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

--

-- >>> pl @("abc" +: C "x") ()

-- Present "abcx" ((+:) "abcx" | p="abc" | q='x')

-- Val "abcx"

--

-- >>> pl @(Fst +: Snd) ("abc" :: T.Text,'x')

-- Present "abcx" ((+:) "abcx" | p="abc" | q='x')

-- Val "abcx"

--

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]

-- | similar to 'Control.Lens.uncons'

--

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

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

--

-- >>> pz @Uncons []

-- Val Nothing

--

-- >>> pz @Uncons (Seq.fromList "abc")

-- Val (Just ('a',fromList "bc"))

--

-- >>> pz @Uncons ("xyz" :: T.Text)

-- Val (Just ('x',"yz"))

--

-- >>> pl @Uncons ("asfd" :: T.Text)

-- Present Just ('a',"sfd") (Uncons Just ('a',"sfd") | "asfd")

-- Val (Just ('a',"sfd"))

--

-- >>> pl @Uncons ("" :: T.Text)

-- Present Nothing (Uncons Nothing | "")

-- Val Nothing

--

-- >>> pl @Uncons [1..5] -- with Typeable would need to specify the type of [1..5]

-- Present Just (1,[2,3,4,5]) (Uncons Just (1,[2,3,4,5]) | [1,2,3,4,5])

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

--

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) []

-- | similar to 'Control.Lens.unsnoc'

--

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

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

--

-- >>> pz @Unsnoc []

-- Val Nothing

--

-- >>> pz @Unsnoc ("xyz" :: T.Text)

-- Val (Just ("xy",'z'))

--

-- >>> pl @Unsnoc ("asfd" :: T.Text)

-- Present Just ("asf",'d') (Unsnoc Just ("asf",'d') | "asfd")

-- Val (Just ("asf",'d'))

--

-- >>> pl @Unsnoc ("" :: T.Text)

-- Present Nothing (Unsnoc Nothing | "")

-- Val Nothing

--

-- >>> pl @Unsnoc [1..5]

-- Present Just ([1,2,3,4],5) (Unsnoc Just ([1,2,3,4],5) | [1,2,3,4,5])

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

--

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) []

-- | rotate a list @p@ @n@ units

--

-- >>> pz @(Rotate 0 Id) [1,2,3,4]

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

--

-- >>> pz @(Rotate (Negate 1) Id) [1,2,3,4]

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

--

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

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

--

-- >>> pz @(Map (Rotate Id "abcd")) [-3..7]

-- Val ["bcda","cdab","dabc","abcd","bcda","cdab","dabc","abcd","bcda","cdab","dabc"]

--

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))


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

--

-- >>> pz @(Partition (Ge 3) Id) [10,4,1,7,3,1,3,5]

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

--

-- >>> pz @(Partition IsPrime Id) [10,4,1,7,3,1,3,5]

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

--

-- >>> pz @(Partition (Ge 300) Id) [10,4,1,7,3,1,3,5]

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

--

-- >>> pz @(Partition (Id < 300) Id) [10,4,1,7,3,1,3,5]

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

--

-- >>> pl @(Partition (Lt 2) Id >> Id) [1,2,3,4,5]

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

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

--

-- >>> pl @(Partition (Gt 3) Id) [1..10]

-- Present ([4,5,6,7,8,9,10],[1,2,3]) (Partition ([4,5,6,7,8,9,10],[1,2,3]) | s=[1,2,3,4,5,6,7,8,9,10])

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

--

-- >>> pl @(Partition Even Id) [1..6]

-- Present ([2,4,6],[1,3,5]) (Partition ([2,4,6],[1,3,5]) | s=[1,2,3,4,5,6])

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

--

-- >>> pl @(Partition Even Id >> Null *** (Len > 4) >> Fst == Snd) [1..6]

-- True ((>>) True | {False == False})

-- Val True

--

-- >>> pl @(Partition (ExitWhen "ExitWhen" (Gt 10) >> Gt 2) Id) [1..11]

-- Error ExitWhen (Partition(i=10, a=11) excnt=1)

-- Fail "ExitWhen"

--

-- >>> pl @(Partition IsPrime Id) [1..15]

-- Present ([2,3,5,7,11,13],[1,4,6,8,9,10,12,14,15]) (Partition ([2,3,5,7,11,13],[1,4,6,8,9,10,12,14,15]) | s=[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15])

-- Val ([2,3,5,7,11,13],[1,4,6,8,9,10,12,14,15])

--

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])) (Int, [x])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 [x]
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 (Int
_,[x]
q) -> 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)

-- | counts number on matches and non matches: ie All is length snd==0 and Any is length fst > 0

--

-- >>> pz @(Quant Even) [2,3,3,7,2,8,1,5,9]

-- Val (3,6)

--

-- >>> pz @(Quant (Gt 10)) [2,8,1,5,9]

-- Val (0,5)

--

-- >>> pz @(Quant (Gt 10)) []

-- Val (0,0)

--

-- >>> pz @(Quant (Same 4)) [3]

-- Val (0,1)

--

-- >>> pz @(Quant (Same 4)) [4]

-- Val (1,0)

--

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))

-- | similar to 'Predicate.All' for non-empty lists

--

-- >>> pz @(All1 Even) [2,4,6]

-- Val True

--

-- >>> pz @(All1 Even) [2,3,3,7,2,8,1,5,9]

-- Val False

--

-- >>> pz @(All1 Even) []

-- Val False

--

-- >>> pz @(All1 Even) [1]

-- Val False

--

-- >>> pz @(All1 Even) [2]

-- Val True

--

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

-- partially hidden example

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

-- | partition values based on a function

--

-- >>> pz @(PartitionBy Ordering (Id ==! 0)  Id) [17,3,-12,0,1,0,-3]

-- Val (fromList [(LT,[-3,-12]),(EQ,[0,0]),(GT,[1,3,17])])

--

-- >>> pz @(PartitionBy Char (Mod Id 16 >> ShowBase 16 >> Head) Id) [-4,-2,5,0,15,12,-1,2,-3,4,0]

-- Val (fromList [('0',[0,0]),('2',[2]),('4',[4]),('5',[5]),('c',[12,-4]),('d',[-3]),('e',[-2]),('f',[-1,15])])

--

-- >>> pl @(PartitionBy Ordering (Case (FailT _ "asdf") '[Id < 2, Id == 2, Id > 2] '[ 'LT, 'EQ, 'GT] Id) Id) [-4,2,5,6,7,1,2,3,4]

-- Present fromList [(LT,[1,-4]),(EQ,[2,2]),(GT,[4,3,7,6,5])] (PartitionBy fromList [(LT,[1,-4]),(EQ,[2,2]),(GT,[4,3,7,6,5])] | s=[-4,2,5,6,7,1,2,3,4])

-- Val (fromList [(LT,[1,-4]),(EQ,[2,2]),(GT,[4,3,7,6,5])])

--

-- >>> pl @(PartitionBy Ordering (Case (FailT _ "xyzxyzxyzzyyysyfsyfydf") '[Id < 2, Id == 2, Id > 3] '[ 'LT, 'EQ, 'GT] Id) Id) [-4,2,5,6,7,1,2,3,4]

-- Error xyzxyzxyzzyyysyfsyfydf (PartitionBy(i=7, a=3) excnt=1)

-- Fail "xyzxyzxyzzyyysyfsyfydf"

--

-- >>> pz @(PartitionBy Ordering (Case 'EQ '[Id < 0, Id > 0] '[ 'LT, 'GT] Id) Id) [-4,-2,5,6,7,0,-1,2,-3,4,0]

-- Val (fromList [(LT,[-3,-1,-2,-4]),(EQ,[0,0]),(GT,[4,2,7,6,5])])

--

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])) (Int, [x])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 [x]
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 (Int
_,[x]
q) -> 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)

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

--

-- >>> pz @(GroupBy (Fst == Snd) Id) [1,3,4,5,1,5,5]

-- Val [[1],[3],[4],[5],[1],[5,5]]

--

-- >>> pz @(GroupBy (Fst == Snd) Id) [1,1,1,3,4,5,1,5,5]

-- Val [[1,1,1],[3],[4],[5],[1],[5,5]]

--

-- >>> pz @(GroupBy (Fst == Snd) Id) [5,5]

-- Val [[5,5]]

--

-- >>> pz @(GroupBy (Fst == Snd) Id) [1,2]

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

--

-- >>> pz @(GroupBy (Fst == Snd) Id) [1]

-- Val [[1]]

--

-- >>> pz @(GroupBy (Fst == Snd) Id) []

-- Val []

--

-- >>> pz @(GroupBy (Fst < Snd) Id) [1,2,3,4,4,1,2]

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

--

-- >>> pz @(GroupBy (Fst /= Snd) Id) [1,2,3,4,4,4,1]

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

--

-- >>> pan @(GroupBy (Fst == Snd) Id) "hello    goodbye"

-- P GroupBy ["h","e","ll","o","    ","g","oo","d","b","y","e"]

-- |

-- +- P Id "hello    goodbye"

-- |

-- +- False i=0: 'h' == 'e'

-- |

-- +- False i=1: 'e' == 'l'

-- |

-- +- True i=2: 'l' == 'l'

-- |

-- +- False i=3: 'l' == 'o'

-- |

-- +- False i=4: 'o' == ' '

-- |

-- +- True i=5: ' ' == ' '

-- |

-- +- True i=6: ' ' == ' '

-- |

-- +- True i=7: ' ' == ' '

-- |

-- +- False i=8: ' ' == 'g'

-- |

-- +- False i=9: 'g' == 'o'

-- |

-- +- True i=10: 'o' == 'o'

-- |

-- +- False i=11: 'o' == 'd'

-- |

-- +- False i=12: 'd' == 'b'

-- |

-- +- False i=13: 'b' == 'y'

-- |

-- `- False i=14: 'y' == 'e'

-- Val ["h","e","ll","o","    ","g","oo","d","b","y","e"]

--

-- >>> pz @(GroupBy (Fst == Snd)  Id) (map (uncurry SG.Arg) [(10,0),(9,4),(9,3),(1,1),(9,6)])

-- Val [[Arg 10 0],[Arg 9 4,Arg 9 3],[Arg 1 1],[Arg 9 6]]

--

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]]) (Int, [x])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 [x]
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 (Int
_,[x]
q) ->
             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)

-- | version of 'GroupCnt' that retains the original ordering

--

-- >>> pz @GroupCntStable "bababab"

-- Val [('b',4),('a',3)]

--

-- >>> pz @GroupCntStable "fedbfefa"

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

--

-- >>> pz @GroupCntStable "fedc"

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

--

-- >>> pz @GroupCntStable "ffff"

-- Val [('f',4)]

--

-- >>> pz @GroupCntStable ""

-- Val []

--

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
forall a b. a -> b -> a
const Int -> Int
forall a. a -> a
id) ([(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 []


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

--

-- >>> pz @Group [1,3,4,5,1,5,5]

-- Val [[1],[3],[4],[5],[1],[5,5]]

--

-- >>> pz @(Sort >> Group) [1,3,4,5,1,5,5]

-- Val [[1,1],[3],[4],[5,5,5]]

--

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)


-- | similar to 'Group' but returns the value and count

--

-- >>> pz @GroupCnt [1,3,4,5,1,5,5]

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

--

-- >>> pz @(Sort >> GroupCnt) [1,3,4,5,1,5,5]

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

--

-- >>> pz @(Sort >> GroupCnt) "xyabxaaaz"

-- Val [('a',4),('b',1),('x',2),('y',1),('z',1)]

--

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 | Bool
tf -> [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
                          | Bool
otherwise -> [a]
ret [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [(Bool, (a, a), c)] -> [[a]]
go [a
a] [(Bool, (a, a), c)]
as

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

--

-- >>> pz @(Filter (Gt 4) Id) [10,1,3,5,-10,12,1]

-- Val [10,5,12]

--

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))

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

--

-- >>> pz @(Break (Ge 3) Id) [10,4,1,7,3,1,3,5]

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

--

-- >>> pz @(Break (Lt 3) Id) [10,4,1,7,3,1,3,5]

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

--

-- >>> pl @(Break (Gt 2) Id) [1..11]

-- Present ([1,2],[3,4,5,6,7,8,9,10,11]) (Break cnt=(2,9))

-- Val ([1,2],[3,4,5,6,7,8,9,10,11])

--

-- >>> pl @(Break (If (Gt 2) 'True (If (Gt 4) (FailT _ "ASfd") 'False)) Id) [1..8]

-- Present ([1,2],[3,4,5,6,7,8]) (Break cnt=(2,6))

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

--

-- >>> pl @(Break (Case 'False '[Gt 2,Gt 4] '[W 'True, FailT _ "ASfd"] Id) Id) [1..8]  -- case version

-- Present ([1,2],[3,4,5,6,7,8]) (Break cnt=(2,6))

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

--

-- >>> pl @(Break (If (Gt 2) (FailT _ "ASfd") 'False) Id) [1..8]

-- Error ASfd (If 'True | Break predicate failed)

-- Fail "ASfd"

--

-- >>> pl @(Break Snd Id) (zip [1..] [False,False,False,True,True,False])

-- Present ([(1,False),(2,False),(3,False)],[(4,True),(5,True),(6,False)]) (Break cnt=(3,3))

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

--

-- >>> pl @(Break Snd Id) (zip [1..] [False,False,False,False])

-- Present ([(1,False),(2,False),(3,False),(4,False)],[]) (Break cnt=(4,0))

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

--

-- >>> pl @(Break Snd Id) (zip [1..] [True,True,True,True])

-- Present ([],[(1,True),(2,True),(3,True),(4,True)]) (Break cnt=(0,4))

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

--

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

-- only process up to the pivot! only process while Right False

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])) (Int, [x])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 [x]
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 (Int
_,[x]
q) -> 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) -- [(ia,qq)] extras | the rest of the data | optional last pivot or failure

                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

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

--

-- >>> pl @(Span (Lt 4) Id) [1..11]

-- Present ([1,2,3],[4,5,6,7,8,9,10,11]) (Break cnt=(3,8))

-- Val ([1,2,3],[4,5,6,7,8,9,10,11])

--

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))

-- | intercalate two lists

--

-- >>> pz @(Intercalate '["aB"] '["xxxx","yz","z","www","xyz"]) ()

-- Val ["xxxx","aB","yz","aB","z","aB","www","aB","xyz"]

--

-- >>> pz @(Intercalate '[W 99,Negate 98] Id) [1..5]

-- Val [1,99,-98,2,99,-98,3,99,-98,4,99,-98,5]

--

-- >>> pz @(Intercalate '[99,100] Id) [1..5]

-- Val [1,99,100,2,99,100,3,99,100,4,99,100,5]

--

-- >>> pl @(Intercalate Fst Snd) ([0,1], [12,13,14,15,16])

-- Present [12,0,1,13,0,1,14,0,1,15,0,1,16] (Intercalate [12,0,1,13,0,1,14,0,1,15,0,1,16] | [0,1] | [12,13,14,15,16])

-- Val [12,0,1,13,0,1,14,0,1,15,0,1,16]

--

-- >>> pl @((Pure [] (Negate Len) &&& Id) >> Intercalate Fst Snd) [12,13,14,15,16]

-- Present [12,-5,13,-5,14,-5,15,-5,16] ((>>) [12,-5,13,-5,14,-5,15,-5,16] | {Intercalate [12,-5,13,-5,14,-5,15,-5,16] | [-5] | [12,13,14,15,16]})

-- Val [12,-5,13,-5,14,-5,15,-5,16]

--

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]) ((Int, [a]), (Int, [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) ((Int, [a]), (Int, [b]))
chkSize2 POpts
opts String
msg0 [a]
p' [a]
q' [Tree PE]
hhs of
          Left TT [a]
e -> TT [a]
e
          Right ((Int
_,[a]
p),(Int
_,[a]
q)) ->
            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

-- | 'elem' function

--

-- >>> pz @(Elem Fst Snd) ('x',"abcdxy")

-- Val True

--

-- >>> pz @(Elem Fst Snd) ('z',"abcdxy")

-- Val False

--

-- >>> pl @(Elem Id '[2,3,4]) 2

-- True (2 `elem` [2,3,4])

-- Val True

--

-- >>> pl @(Elem Id '[2,3,4]) 6

-- False (6 `elem` [2,3,4])

-- Val False

--

-- >>> pl @(Elem Id '[13 % 2]) 6.5

-- True (13 % 2 `elem` [13 % 2])

-- Val True

--

-- >>> pl @(Elem Id '[13 % 2, 12 % 1]) 6.5

-- True (13 % 2 `elem` [13 % 2,12 % 1])

-- Val True

--

-- >>> pl @(Elem Id '[13 % 2, 12 % 1]) 6

-- False (6 % 1 `elem` [13 % 2,12 % 1])

-- Val False

--

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]

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

--

-- >>> pz @Inits [4,8,3,9]

-- Val [[],[4],[4,8],[4,8,3],[4,8,3,9]]

--

-- >>> pz @Inits []

-- Val [[]]

--

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) []

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

--

-- >>> pz @Tails [4,8,3,9]

-- Val [[4,8,3,9],[8,3,9],[3,9],[9],[]]

--

-- >>> pz @Tails []

-- Val [[]]

--

-- >>> pl @Tails "abcd"

-- Present ["abcd","bcd","cd","d",""] (Tails ["abcd","bcd","cd","d",""] | "abcd")

-- Val ["abcd","bcd","cd","d",""]

--

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) []

-- | split a list into single values

--

-- >>> pz @Ones [4,8,3,9]

-- Val [[4],[8],[3],[9]]

--

-- >>> pz @Ones []

-- Val []

--

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]]) (Int, [a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 x
[a]
x' [] of
          Left TT [[a]]
e -> TT [[a]]
e
          Right (Int
_,[a]
x) ->
            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 [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
<> String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool String
"R" String
"L" Bool
lft
        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' ->
            case POpts
-> String
-> [PP p a]
-> [Tree PE]
-> Either (TT [PP p a]) (Int, [PP p a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 [PP p a]
q' [] of
              Left TT [PP p a]
e -> TT [PP p a]
e
              Right (Int
qLen,[PP p a]
q) ->
                let diff :: Int
diff = if Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
qLen then Int
0 else Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
qLen
                    bs :: [PP p a]
bs = ([PP p a] -> [PP p a])
-> ([PP p a] -> [PP p a]) -> Bool -> [PP p a] -> [PP p a]
forall a. a -> a -> Bool -> a
bool ([PP p a]
q [PP p a] -> [PP p a] -> [PP p a]
forall a. Semigroup a => a -> a -> a
<>) ([PP p a] -> [PP p a] -> [PP p a]
forall a. Semigroup a => a -> a -> a
<> [PP p a]
q) Bool
lft (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])

-- | left pad @q@ with @n@ values from @p@

--

-- >>> pl @(PadL 5 0 Id) [1..3]

-- Present [0,0,1,2,3] (PadL 5 pad=0 [0,0,1,2,3] | [1,2,3])

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

--

-- >>> pz @(PadL 5 999 Id) [12,13]

-- Val [999,999,999,12,13]

--

-- >>> pz @(PadR 5 Fst '[12,13]) (999,'x')

-- Val [12,13,999,999,999]

--

-- >>> pz @(PadR 2 Fst '[12,13,14]) (999,'x')

-- Val [12,13,14]

--

-- >>> pl @(PadL 10 0 Id) [1..3]

-- Present [0,0,0,0,0,0,0,1,2,3] (PadL 10 pad=0 [0,0,0,0,0,0,0,1,2,3] | [1,2,3])

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

--

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))

-- | right pad @q@ with @n@ values from @p@

--

-- >>> pl @(PadR 5 8 Id) [1..3]

-- Present [1,2,3,8,8] (PadR 5 pad=8 [1,2,3,8,8] | [1,2,3])

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

--

-- >>> pl @(PadR 5 0 Id) [1..5]

-- Present [1,2,3,4,5] (PadR 5 pad=0 [1,2,3,4,5] | [1,2,3,4,5])

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

--

-- >>> pl @(PadR 5 0 Id) [1..6]

-- Present [1,2,3,4,5,6] (PadR 5 pad=0 [1,2,3,4,5,6] | [1,2,3,4,5,6])

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

--

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))

-- | split a list @p@ into parts using the lengths in the type level list @ns@

--

-- >>> pz @(SplitAts '[2,3,1,1] Id) "hello world"

-- Val ["he","llo"," ","w","orld"]

--

-- >>> pz @(SplitAts '[2] Id) "hello world"

-- Val ["he","llo world"]

--

-- >>> pz @(SplitAts '[10,1,1,5] Id) "hello world"

-- Val ["hello worl","d","",""]

--

-- >>> pl @(SplitAts '[1,3,4] Id) [1..12]

-- Present [[1],[2,3,4],[5,6,7,8],[9,10,11,12]] (SplitAts [[1],[2,3,4],[5,6,7,8],[9,10,11,12]] | ns=[1,3,4] | [1,2,3,4,5,6,7,8,9,10,11,12])

-- Val [[1],[2,3,4],[5,6,7,8],[9,10,11,12]]

--

-- >>> pl @(SplitAts '[3,1,1,1] Id >> Filter (Not Null) Id) [1..4]

-- Present [[1,2,3],[4]] ((>>) [[1,2,3],[4]] | {Fst [[1,2,3],[4]] | ([[1,2,3],[4]],[[],[]])})

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

--

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 hhs :: [Tree PE]
hhs = [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]
        in case POpts -> String -> [a] -> [Tree PE] -> Either (TT [[a]]) (Int, [a])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 [a]
p' [Tree PE]
hhs of
             Left TT [[a]]
e -> TT [[a]]
e
             Right (Int
pLen,[a]
p) ->
               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 -> Int -> [a] -> ([a], [a])
forall a. Int -> Int -> [a] -> ([a], [a])
splitAtNeg Int
pLen (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) [Tree PE]
hhs

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

--

-- >>> pz @(SplitAt 4 Id) "hello world"

-- Val ("hell","o world")

--

-- >>> pz @(SplitAt 20 Id) "hello world"

-- Val ("hello world","")

--

-- >>> pz @(SplitAt 0 Id) "hello world"

-- Val ("","hello world")

--

-- >>> pz @(SplitAt Snd Fst) ("hello world",4)

-- Val ("hell","o world")

--

-- >>> pz @(SplitAt (Negate 2) Id) "hello world"

-- Val ("hello wor","ld")

--

-- >>> pl @(Snd >> SplitAt 2 Id >> Len *** Len >> Fst > Snd) ('x',[1..5])

-- False ((>>) False | {2 > 3})

-- Val False

--

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 -- (Left e, tt')

      Right (PP n a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n,[b]
p',TT (PP n a)
nn,TT [b]
pp) ->
        let hhs :: [Tree PE]
hhs = [TT (PP n a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP n a)
nn, TT [b] -> Tree PE
forall a. TT a -> Tree PE
hh TT [b]
pp]
        in case POpts
-> String -> [b] -> [Tree PE] -> Either (TT ([b], [b])) (Int, [b])
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) (Int, [a])
chkSize POpts
opts String
msg0 [b]
p' [Tree PE]
hhs of
             Left TT ([b], [b])
e -> TT ([b], [b])
e
             Right (Int
pLen,[b]
p) ->
               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 -> Int -> [b] -> ([b], [b])
forall a. Int -> Int -> [a] -> ([a], [a])
splitAtNeg Int
pLen 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) [Tree PE]
hhs

splitAtNeg :: Int -> Int -> [a] -> ([a], [a])
--splitAtNeg len n = splitAt (if n<0 then len + n else n)

splitAtNeg :: Int -> Int -> [a] -> ([a], [a])
splitAtNeg Int
len = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> [a] -> ([a], [a]))
-> (Int -> Int) -> Int -> [a] -> ([a], [a])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> (Int -> Int) -> (Int -> Int) -> Int -> Int
forall (m :: Type -> Type) a.
Monad m =>
m Bool -> m a -> m a -> m a
ifM (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0) (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+) Int -> Int
forall a. a -> a
id

-- | take @n@ values from a list @p@: similar to 'Prelude.take'

--

-- >>> pz @(Take 3 Id) "abcdef"

-- Val "abc"

--

-- >>> pz @(Take 3 Id) "ab"

-- Val "ab"

--

-- >>> pz @(Take 10 Id) "abcdef"

-- Val "abcdef"

--

-- >>> pz @(Take 0 Id) "abcdef"

-- Val ""

--

-- >>> pz @(Take 10 Id) ""

-- Val ""

--

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))

-- | drop @n@ values from a list @p@: similar to 'Prelude.drop'

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))

-- | splits a list pointed to by @p@ into lists of size @n@

--

-- >>> pz @(ChunksOf 2) "abcdef"

-- Val ["ab","cd","ef"]

--

-- >>> pz @(ChunksOf 2) "abcdefg"

-- Val ["ab","cd","ef","g"]

--

-- >>> pz @(ChunksOf 2) ""

-- Val []

--

-- >>> pz @(ChunksOf 2) "a"

-- Val ["a"]

--

-- >>> pz @(PadR (Len + RoundUp 5 Len) 999 Id >> ChunksOf 5) [1..17]

-- Val [[1,2,3,4,5],[6,7,8,9,10],[11,12,13,14,15],[16,17,999,999,999]]

--

-- >>> pz @(PadR (Len + RoundUp 5 Len) 999 Id >> ChunksOf 5) [1..15]

-- Val [[1,2,3,4,5],[6,7,8,9,10],[11,12,13,14,15]]

--

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))

-- | splits a list pointed to by @p@ into lists of size @n@ with a gap of @i@

--

-- >>> pz @(Unfoldr (If Null (MkNothing _) (MkJust '(Take 3 Id,Drop 2 Id))) Id) [1..10]

-- Val [[1,2,3],[3,4,5],[5,6,7],[7,8,9],[9,10]]

--

-- >>> pz @(ChunksOf' 3 2 Id) [1..10]

-- Val [[1,2,3],[3,4,5],[5,6,7],[7,8,9],[9,10]]

--

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
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
" i<=0")) 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

-- empty lists at the type level wont work here


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 = String -> String -> Bool -> String
forall a. a -> a -> Bool -> a
bool String
"Remove" String
"Keep" Bool
keep
        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]

-- | filters a list @q@ keeping those elements in @p@

--

-- >>> pz @(Keep '[5] '[1,5,5,2,5,2]) ()

-- Val [5,5,5]

--

-- >>> pz @(Keep '[0,1,1,5] '[1,5,5,2,5,2]) ()

-- Val [1,5,5,5]

--

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))

-- | filters a list @q@ removing those elements in @p@

--

-- >>> pz @(Remove '[5] '[1,5,5,2,5,2]) ()

-- Val [1,2,2]

--

-- >>> pz @(Remove '[0,1,1,5] '[1,5,5,2,5,2]) ()

-- Val [2,2]

--

-- >>> pz @(Remove '[99] '[1,5,5,2,5,2]) ()

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

--

-- >>> pz @(Remove '[99,91] '[1,5,5,2,5,2]) ()

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

--

-- >>> pz @(Remove Id '[1,5,5,2,5,2]) []

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

--

-- >>> pz @(Remove '[] '[1,5,5,2,5,2]) 44 -- works if you make this a number!

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

--

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))

-- | takes the head of a list-like container: similar to 'Data.List.head'

--

-- >>> pz @Head "abcd"

-- Val 'a'

--

-- >>> pl @Head []

-- Error Head(empty)

-- Fail "Head(empty)"

--

-- >>> pl @(Fst >> Head >> Le 6) ([], True)

-- Error Head(empty)

-- Fail "Head(empty)"

--

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

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

-- Val 1

--

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) []

-- | takes the tail of a list-like container: similar to 'Data.List.tail'

--

-- >>> pz @Tail "abcd"

-- Val "bcd"

--

-- >>> pl @Tail [1..5]

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

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

--

-- >>> pl @Tail []

-- Error Tail(empty)

-- Fail "Tail(empty)"

--

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) []


-- | takes the last of a list-like container: similar to 'Data.List.last'

--

-- >>> pz @Last "abcd"

-- Val 'd'

--

-- >>> pz @Last []

-- Fail "Last(empty)"

--

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

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

-- Val 3

--

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) []

-- | takes the init of a list-like container: similar to 'Data.List.init'

--

-- >>> pz @Init "abcd"

-- Val "abc"

--

-- >>> pz @Init (T.pack "abcd")

-- Val "abc"

--

-- >>> pz @Init []

-- Fail "Init(empty)"

--

-- >>> pl @Init [1..5]

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

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

--

-- >>> pl @Init []

-- Error Init(empty)

-- Fail "Init(empty)"

--

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) []


-- | 'unzip' equivalent

--

-- >>> pz @Unzip (zip [1..5] "abcd")

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

--

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)


-- | 'unzip3' equivalent

--

-- >>> pz @Unzip3 (zip3 [1..5] "abcd" (cycle [True,False]))

-- Val ([1,2,3,4],"abcd",[True,False,True,False])

--

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)

-- | sort a list (stable)

--

-- >>> pz @(SortBy (Snd ==! Fst) Id) [(10,"ab"),(4,"x"),(20,"bbb")]

-- Val [(20,"bbb"),(10,"ab"),(4,"x")]

--

-- >>> pz @(SortBy 'LT Id) [1,5,2,4,7,0]

-- Val [1,5,2,4,7,0]

--

-- >>> pz @(SortBy 'GT Id) [1,5,2,4,7,0]

-- Val [0,7,4,2,5,1]

--

-- >>> pz @(SortBy ((L11 ==! L21) <> (L12 ==! L22)) Id) [(10,"ab"),(4,"x"),(20,"bbb"),(4,"a"),(4,"y")]

-- Val [(4,"a"),(4,"x"),(4,"y"),(10,"ab"),(20,"bbb")]

--

-- >>> pz @(SortBy ((L11 ==! L21) <> (L22 ==! L12)) Id) [(10,"ab"),(4,"x"),(20,"bbb"),(4,"a"),(4,"y")]

-- Val [(4,"y"),(4,"x"),(4,"a"),(10,"ab"),(20,"bbb")]

--

-- >>> pl @(SortBy (Swap >> Comparing Fst) Snd) ((),[('z',1),('a',10),('m',22)])

-- Present [('z',1),('m',22),('a',10)] (SortBy [('z',1),('m',22),('a',10)])

-- Val [('z',1),('m',22),('a',10)]

--

-- >>> pl @(SortBy (Comparing Reverse) Id) ["az","by","cx","aa"]

-- Present ["aa","cx","by","az"] (SortBy ["aa","cx","by","az"])

-- Val ["aa","cx","by","az"]

--

-- >>> pl @(SortBy (If (Fst==5 && Snd==3) (FailT _ (PrintT "pivot=%d value=%d" Id)) 'GT) Snd) ((), [5,7,3,1,6,2,1,3])

-- Error pivot=5 value=3(2) (Partition(i=1, a=(5,3)) excnt=2 | SortBy)

-- Fail "pivot=5 value=3(2)"

--

-- >>> pl @(SortBy (If (Fst==50 && Snd==3) (FailT _ (PrintT "pivot=%d value=%d" Id)) Compare) Snd) ((), [5,7,3,1,6,2,1,3])

-- Present [1,1,2,3,3,5,6,7] (SortBy [1,1,2,3,3,5,6,7])

-- Val [1,1,2,3,3,5,6,7]

--

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 -- dont rewrap or rewrite

                        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] -> Bool
forall a. [a] -> Bool
lengthGreaterThanOne [a]
ll] [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] -> Bool
forall a. [a] -> Bool
lengthGreaterThanOne [a]
rr])
        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 -- dont rewrap else will double up messages: already handled

          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]

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

--

-- >>> pz @(SortOn Fst Id) [(10,"abc"), (3,"def"), (4,"gg"), (10,"xyz"), (1,"z")]

-- Val [(1,"z"),(3,"def"),(4,"gg"),(10,"abc"),(10,"xyz")]

--

-- >>> pl @(SortOn Id Id) [10,4,2,12,14]

-- Present [2,4,10,12,14] (SortBy [2,4,10,12,14])

-- Val [2,4,10,12,14]

--

-- >>> pl @(SortOn (Negate Id) Id) [10,4,2,12,14]

-- Present [14,12,10,4,2] (SortBy [14,12,10,4,2])

-- Val [14,12,10,4,2]

--

-- >>> pl @(SortOn Fst Id) (zip "cabdaz" [10,4,2,12,14,1])

-- Present [('a',4),('a',14),('b',2),('c',10),('d',12),('z',1)] (SortBy [('a',4),('a',14),('b',2),('c',10),('d',12),('z',1)])

-- Val [('a',4),('a',14),('b',2),('c',10),('d',12),('z',1)]

--

-- >>> pl @(SortOn (FailS "asdf") Id) [10,4,2,12,14]

-- Error asdf(4) (Partition(i=0, a=(10,4)) excnt=4 | SortBy)

-- Fail "asdf(4)"

--

-- >>> pl @(SortOn Snd Snd) ((),[('z',14),('a',10),('m',22),('a',1)])

-- Present [('a',1),('a',10),('z',14),('m',22)] (SortBy [('a',1),('a',10),('z',14),('m',22)])

-- Val [('a',1),('a',10),('z',14),('m',22)]

--

-- >>> pl @(SortOn Fst Snd) ((),[('z',1),('a',10),('m',22)])

-- Present [('a',10),('m',22),('z',1)] (SortBy [('a',10),('m',22),('z',1)])

-- Val [('a',10),('m',22),('z',1)]

--

-- >>> pl @(SortOn Fst Id) [('z',1),('a',10),('m',22),('a',9),('m',10)]

-- Present [('a',10),('a',9),('m',22),('m',10),('z',1)] (SortBy [('a',10),('a',9),('m',22),('m',10),('z',1)])

-- Val [('a',10),('a',9),('m',22),('m',10),('z',1)]

--

-- >>> pl @(SortOn Id Id) [('z',1),('a',10),('m',22),('a',9),('m',10)]

-- Present [('a',9),('a',10),('m',10),('m',22),('z',1)] (SortBy [('a',9),('a',10),('m',10),('m',22),('z',1)])

-- Val [('a',9),('a',10),('m',10),('m',22),('z',1)]

--

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 (Comparing 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))

-- | like SortOn but descending order

--

-- >>> pl @(SortOnDesc Id Id) [10,4,2,12,14]

-- Present [14,12,10,4,2] (SortBy [14,12,10,4,2])

-- Val [14,12,10,4,2]

--

-- >>> pl @(SortOnDesc Fst Snd) ((),[('z',1),('a',10),('m',22)])

-- Present [('z',1),('m',22),('a',10)] (SortBy [('z',1),('m',22),('a',10)])

-- Val [('z',1),('m',22),('a',10)]

--

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 >> Comparing 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))

-- | simple sort: similar to 'Prelude.sort'

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)

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

--

-- >>> pz @Reverse [1,2,4]

-- Val [4,2,1]

--

-- >>> pz @Reverse "AbcDeF"

-- Val "FeDcbA"

--

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) []

-- | reverses using 'reversing'

--

-- >>> pz @ReverseL (T.pack "AbcDeF")

-- Val "FeDcbA"

--

-- >>> pz @ReverseL "AbcDeF"

-- Val "FeDcbA"

--

-- >>> pl @ReverseL ("asfd" :: T.Text)

-- Present "dfsa" (ReverseL "dfsa" | "asfd")

-- Val "dfsa"

--

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) []

-- | creates a singleton from a value

--

-- >>> pz @(Singleton (C "aBc")) ()

-- Val "a"

--

-- >>> pz @(Singleton Id) False

-- Val [False]

--

-- >>> pz @(Singleton Snd) (False,"hello")

-- Val ["hello"]

--

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]

-- | like 'zipWith'

--

-- >>> pz @(ZipWith Id (1...5) (C "a" ... C "e")) ()

-- Val [(1,'a'),(2,'b'),(3,'c'),(4,'d'),(5,'e')]

--

-- >>> pz @(ZipWith (ShowP Fst <> ShowP Snd) (1...5) (C "a" ... C "e")) ()

-- Val ["1'a'","2'b'","3'c'","4'd'","5'e'"]

--

-- >>> pz @(ZipWith (MkThese Fst Snd) (1...6) (C "a" ... C "f")) ()

-- Val [These 1 'a',These 2 'b',These 3 'c',These 4 'd',These 5 'e',These 6 'f']

--

-- >>> pz @(ZipWith (MkThese Fst Snd) '[] (C "a" ... C "f")) ()

-- Fail "ZipWith(0,6) length mismatch"

--

-- >>> pz @(ZipWith (MkThese Fst Snd) (1...3) (C "a" ... C "f")) ()

-- Fail "ZipWith(3,6) length mismatch"

--

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)]) ((Int, [x]), (Int, [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) ((Int, [a]), (Int, [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 ((Int
qLen,[x]
q),(Int
rLen,[y]
r))
            | Int
qLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
rLen -> 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)

            | Bool
otherwise ->
                   let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int, Int) -> String
forall a. Show a => a -> String
show (Int
qLen,Int
rLen)
                   in 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

-- | Zip two lists to their maximum length using optional padding

--

-- >>> pz @(ZipPad (C "Z") 99 Fst Snd) ("abc", [1..5])

-- Val [('a',1),('b',2),('c',3),('Z',4),('Z',5)]

--

-- >>> pz @(ZipPad (C "Z") 99 Fst Snd) ("abcdefg", [1..5])

-- Val [('a',1),('b',2),('c',3),('d',4),('e',5),('f',99),('g',99)]

--

-- >>> pz @(ZipPad (C "Z") 99 Fst Snd) ("abcde", [1..5])

-- Val [('a',1),('b',2),('c',3),('d',4),('e',5)]

--

-- >>> pz @(ZipPad (C "Z") 99 Fst Snd) ("", [1..5])

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

--

-- >>> pz @(ZipPad (C "Z") 99 Fst Snd) ("abcde", [])

-- Val [('a',99),('b',99),('c',99),('d',99),('e',99)]

--

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)]) ((Int, [x]), (Int, [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) ((Int, [a]), (Int, [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 ((Int
pLen,[x]
p),(Int
qLen,[y]
q)) -> do
            case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
pLen Int
qLen 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


-- | zip two lists optionally padding the left hand side

--

-- >>> pl @(ZipL 99 '[1,2,3] "abc") ()

-- Present [(1,'a'),(2,'b'),(3,'c')] (ZipL [(1,'a'),(2,'b'),(3,'c')] | p=[1,2,3] | q="abc")

-- Val [(1,'a'),(2,'b'),(3,'c')]

--

-- >>> pl @(ZipL 99 '[1,2] "abc") ()

-- Present [(1,'a'),(2,'b'),(99,'c')] (ZipL [(1,'a'),(2,'b'),(99,'c')] | p=[1,2] | q="abc")

-- Val [(1,'a'),(2,'b'),(99,'c')]

--

-- >>> pl @(ZipL 99 '[1] "abc") ()

-- Present [(1,'a'),(99,'b'),(99,'c')] (ZipL [(1,'a'),(99,'b'),(99,'c')] | p=[1] | q="abc")

-- Val [(1,'a'),(99,'b'),(99,'c')]

--

-- >>> pl @(ZipL 99 '[1,2,3] "ab") ()

-- Error ZipL(3,2) rhs would be truncated (p=[1,2,3] | q="ab")

-- Fail "ZipL(3,2) rhs would be truncated"

--

-- >>> pl @(ZipL 99 Id "abcdefg") [1..4]

-- Present [(1,'a'),(2,'b'),(3,'c'),(4,'d'),(99,'e'),(99,'f'),(99,'g')] (ZipL [(1,'a'),(2,'b'),(3,'c'),(4,'d'),(99,'e'),(99,'f'),(99,'g')] | p=[1,2,3,4] | q="abcdefg")

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

--

-- >>> pl @(ZipL (99 % 4) '[1 % 1 , 2 % 1 , 3 % 1] Id) "abcde"

-- Present [(1 % 1,'a'),(2 % 1,'b'),(3 % 1,'c'),(99 % 4,'d'),(99 % 4,'e')] (ZipL [(1 % 1,'a'),(2 % 1,'b'),(3 % 1,'c'),(99 % 4,'d'),(99 % 4,'e')] | p=[1 % 1,2 % 1,3 % 1] | q="abcde")

-- Val [(1 % 1,'a'),(2 % 1,'b'),(3 % 1,'c'),(99 % 4,'d'),(99 % 4,'e')]

--

-- >>> pl @(ZipL "X" (EmptyT _ _) Id) "abcd"

-- Present [("X",'a'),("X",'b'),("X",'c'),("X",'d')] (ZipL [("X",'a'),("X",'b'),("X",'c'),("X",'d')] | p=[] | q="abcd")

-- Val [("X",'a'),("X",'b'),("X",'c'),("X",'d')]

--


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)]) ((Int, [x]), (Int, [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) ((Int, [a]), (Int, [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 ((Int
pLen,[x]
p),(Int
qLen,[y]
q)) -> do
            case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
pLen Int
qLen 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
pLen,Int
qLen)
                    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])

-- | zip two lists optionally padding the right hand side

--

-- >>> pl @(ZipR (C "Z") '[1,2,3] "abc") ()

-- Present [(1,'a'),(2,'b'),(3,'c')] (ZipR [(1,'a'),(2,'b'),(3,'c')] | p=[1,2,3] | q="abc")

-- Val [(1,'a'),(2,'b'),(3,'c')]

--

-- >>> pl @(ZipR (C "Z") '[1,2,3] "ab") ()

-- Present [(1,'a'),(2,'b'),(3,'Z')] (ZipR [(1,'a'),(2,'b'),(3,'Z')] | p=[1,2,3] | q="ab")

-- Val [(1,'a'),(2,'b'),(3,'Z')]

--

-- >>> pl @(ZipR (C "Z") '[1,2,3] "a") ()

-- Present [(1,'a'),(2,'Z'),(3,'Z')] (ZipR [(1,'a'),(2,'Z'),(3,'Z')] | p=[1,2,3] | q="a")

-- Val [(1,'a'),(2,'Z'),(3,'Z')]

--

-- >>> pl @(ZipR (C "Z") '[1,2] "abc") ()

-- Error ZipR(2,3) rhs would be truncated (p=[1,2] | q="abc")

-- Fail "ZipR(2,3) rhs would be truncated"

--

-- >>> pl @(ZipR (C "Y") (EmptyT _ _) Id) "abcd"

-- Error ZipR(0,4) rhs would be truncated (p=[] | q="abcd")

-- Fail "ZipR(0,4) rhs would be truncated"

--

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)]) ((Int, [x]), (Int, [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) ((Int, [a]), (Int, [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 ((Int
pLen,[x]
p),(Int
qLen,[y]
q)) -> do
            case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
pLen Int
qLen 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
pLen,Int
qLen)
                    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])

-- | zip two lists with the same length

--

-- >>> pl @(Zip '[1,2,3] "abc") ()

-- Present [(1,'a'),(2,'b'),(3,'c')] (Zip [(1,'a'),(2,'b'),(3,'c')] | p=[1,2,3] | q="abc")

-- Val [(1,'a'),(2,'b'),(3,'c')]

--

-- >>> pl @(Zip '[1,2,3] "ab") ()

-- Error Zip(3,2) length mismatch (p=[1,2,3] | q="ab")

-- Fail "Zip(3,2) length mismatch"

--

-- >>> pl @(Zip '[1,2] "abc") ()

-- Error Zip(2,3) length mismatch (p=[1,2] | q="abc")

-- Fail "Zip(2,3) length mismatch"

--

-- >>> pl @(Zip "abc" Id) [1..7]

-- Error Zip(3,7) length mismatch (p="abc" | q=[1,2,3,4,5,6,7])

-- Fail "Zip(3,7) length mismatch"

--

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)]) ((Int, [x]), (Int, [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) ((Int, [a]), (Int, [b]))
chkSize2 POpts
opts String
msg0 [x]
p' [y]
q' [Tree PE]
hhs of
          Left TT [(x, y)]
e -> TT [(x, y)]
e
          Right ((Int
pLen,[x]
p),(Int
qLen,[y]
q)) -> do
            case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
pLen Int
qLen 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
pLen,Int
qLen)
                      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