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

module Predicate.Data.Iterator (
  -- ** functions

    Scanl
  , ScanN
  , ScanNA
  , FoldN
  , Foldl
  , Unfoldr
  , IterateUntil
  , IterateWhile
  , IterateNWhile
  , IterateNUntil
  , UnfoldN

  , Para
  , ParaN

  , DoN
  , Repeat

  -- ** type families

  , UnfoldrT
 ) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Predicate.Data.Tuple (type (***))
import Predicate.Data.Ordering (type (>))
import Predicate.Data.Enum (type (...), Pred)
import Predicate.Data.List (Last)
import Predicate.Data.Maybe (MaybeBool)
import GHC.TypeLits (Nat, KnownNat, ErrorMessage((:$$:),(:<>:)))
import qualified GHC.TypeLits as GL
import Data.Kind (Type)
import Control.Lens
import Data.Proxy (Proxy(Proxy))
import Data.Maybe (catMaybes)
import Control.Arrow (Arrow((&&&)))
import Data.Void (Void)

-- $setup

-- >>> import Predicate

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XAllowAmbiguousTypes

-- >>> :set -XOverloadedStrings

-- >>> :set -XFlexibleContexts

-- >>> import Data.Time


-- want to pass Proxy b to q but then we have no way to calculate 'b'


-- | similar to 'scanl'

--

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

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

--

-- >>> pl @(Scanl (Snd :+ Fst) Fst Snd) ([99],[])

-- Present [[99]] (Scanl [[99]] | b=[99] | as=[])

-- Val [[99]]

--

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

-- result is scanl but signature is flipped ((a,b) -> b) -> b -> [a] -> [b]


instance ( PP p (b,a) ~ b
         , PP q x ~ b
         , PP r x ~ [a]
         , P p (b,a)
         , P q x
         , P r x
         , Show b
         , Show a
         )
     => P (Scanl p q r) x where
  type PP (Scanl p q r) x = [PP q x]
  eval :: proxy (Scanl p q r) -> POpts -> x -> m (TT (PP (Scanl p q r) x))
eval proxy (Scanl p q r)
_ POpts
opts x
z = do
    let msg0 :: String
msg0 = String
"Scanl"
    Either (TT [b]) (b, [a], TT b, TT [a])
lr <- Inline
-> String
-> Proxy q
-> Proxy r
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT [b]) (PP q x, PP r x, TT (PP q x), TT (PP r x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy q
forall k (t :: k). Proxy t
Proxy @q) (Proxy r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts x
z []
    case Either (TT [b]) (b, [a], TT b, TT [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 (b
q,[a]
r,TT b
qq,TT [a]
rr) ->
        case POpts -> String -> [a] -> [Tree PE] -> Either (TT [b]) (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]
r [TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
rr] 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 (Int, [a])
_ -> do
            let ff :: Int
-> b
-> [a]
-> [((Int, b), TT b)]
-> m ([((Int, b), TT b)], Either (TT [b]) ())
ff Int
i b
b [a]
as' [((Int, b), TT b)]
rs
                 | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= POpts -> Int
getMaxRecursionValue POpts
opts = ([((Int, b), TT b)], Either (TT [b]) ())
-> m ([((Int, b), TT b)], Either (TT [b]) ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([((Int, b), TT b)]
rs, TT [b] -> Either (TT [b]) ()
forall a b. a -> Either a b
Left (TT [b] -> Either (TT [b]) ()) -> TT [b] -> Either (TT [b]) ()
forall a b. (a -> b) -> a -> b
$ 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
":recursion limit i=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)) (String
"(b,as')=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> (b, [a]) -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts (b
b,[a]
as')) [])
                 | Bool
otherwise =
                       case [a]
as' of
                         [] -> ([((Int, b), TT b)], Either (TT [b]) ())
-> m ([((Int, b), TT b)], Either (TT [b]) ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([((Int, b), TT b)]
rs, () -> Either (TT [b]) ()
forall a b. b -> Either a b
Right ()) -- ++ [((i,q), mkNode opts (Val q) (msg0 <> "(done)") [])], Right ())

                         a
a:[a]
as -> do
                            TT b
pp :: TT b <- POpts -> (b, a) -> m (TT (PP p (b, a)))
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p a) =>
POpts -> a -> m (TT (PP p a))
evalHide @p POpts
opts (b
b,a
a)
                            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
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" i=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" a=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
a) TT b
pp [] of
                               Left TT [b]
e  -> ([((Int, b), TT b)], Either (TT [b]) ())
-> m ([((Int, b), TT b)], Either (TT [b]) ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([((Int, b), TT b)]
rs,TT [b] -> Either (TT [b]) ()
forall a b. a -> Either a b
Left TT [b]
e)
                               Right b
b' -> Int
-> b
-> [a]
-> [((Int, b), TT b)]
-> m ([((Int, b), TT b)], Either (TT [b]) ())
ff (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) b
b' [a]
as ([((Int, b), TT b)]
rs [((Int, b), TT b)] -> [((Int, b), TT b)] -> [((Int, b), TT b)]
forall a. [a] -> [a] -> [a]
++ [((Int
i,b
b), TT b
pp)])
            ([((Int, b), TT b)]
ts,Either (TT [b]) ()
lrx) :: ([((Int, b), TT b)], Either (TT [b]) ()) <- Int
-> b
-> [a]
-> [((Int, b), TT b)]
-> m ([((Int, b), TT b)], Either (TT [b]) ())
ff Int
1 b
q [a]
r []
            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 POpts
-> String
-> [((Int, b), TT b)]
-> Either (TT Any) [(b, (Int, b), TT b)]
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
0,b
q), 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
q) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(initial)") []) ((Int, b), TT b) -> [((Int, b), TT b)] -> [((Int, b), TT b)]
forall a. a -> [a] -> [a]
: [((Int, b), TT b)]
ts) of
                 Left TT Any
e -> String -> TT [b]
forall x. HasCallStack => String -> x
errorInProgram (String -> TT [b]) -> String -> TT [b]
forall a b. (a -> b) -> a -> b
$ String
"Scanl e=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tree PE -> String
forall a. Show a => a -> String
show (TT Any -> Tree PE
forall a. TT a -> Tree PE
hh TT Any
e)
                 Right [(b, (Int, b), TT b)]
abcs ->
                   let vals :: [b]
vals = ((b, (Int, b), TT b) -> b) -> [(b, (Int, b), TT b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Getting b (b, (Int, b), TT b) b -> (b, (Int, b), TT b) -> b
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting b (b, (Int, b), TT b) b
forall s t a b. Field1 s t a b => Lens s t a b
_1) [(b, (Int, b), TT b)]
abcs
                       itts :: [((Int, b), TT b)]
itts = ((b, (Int, b), TT b) -> ((Int, b), TT b))
-> [(b, (Int, b), TT b)] -> [((Int, b), TT b)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting (Int, b) (b, (Int, b), TT b) (Int, b)
-> (b, (Int, b), TT b) -> (Int, b)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (Int, b) (b, (Int, b), TT b) (Int, b)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((b, (Int, b), TT b) -> (Int, b))
-> ((b, (Int, b), TT b) -> TT b)
-> (b, (Int, b), TT b)
-> ((Int, b), TT b)
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting (TT b) (b, (Int, b), TT b) (TT b)
-> (b, (Int, b), TT b) -> TT b
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting (TT b) (b, (Int, b), TT b) (TT b)
forall s t a b. Field3 s t a b => Lens s t a b
_3) [(b, (Int, b), TT b)]
abcs
                   in case Either (TT [b]) ()
lrx of
                        Left TT [b]
e -> POpts -> TT [b] -> String -> [Tree PE] -> TT [b]
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT [b]
e String
msg0 (TT b -> Tree PE
forall a. TT a -> Tree PE
hh TT b
qq Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
rr Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: (((Int, b), TT b) -> Tree PE) -> [((Int, b), TT b)] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT b -> Tree PE
forall a. TT a -> Tree PE
hh (TT b -> Tree PE)
-> (((Int, b), TT b) -> TT b) -> ((Int, b), TT b) -> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, b), TT b) -> TT b
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) [((Int, b), TT b)]
itts)
                        Right () -> 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]
vals) (POpts -> String -> [b] -> String -> b -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg0 [b]
vals String
"b=" b
q 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
" | as=" [a]
r) (TT b -> Tree PE
forall a. TT a -> Tree PE
hh TT b
qq Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
rr Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: (((Int, b), TT b) -> Tree PE) -> [((Int, b), TT b)] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT b -> Tree PE
forall a. TT a -> Tree PE
hh (TT b -> Tree PE)
-> (((Int, b), TT b) -> TT b) -> ((Int, b), TT b) -> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, b), TT b) -> TT b
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) [((Int, b), TT b)]
itts)

-- | iterates n times keeping all the results

--

-- >>> pz @(ScanN 4 Succ Id) 'c'

-- Val "cdefg"

--

-- >>> pz @(Dup >> ScanN 4 (Pred *** Succ) Id) 'g'

-- Val [('g','g'),('f','h'),('e','i'),('d','j'),('c','k')]

--

-- >>> pz @(ScanN 4 Succ Id) 4

-- Val [4,5,6,7,8]

--

-- >>> pz @('(0,1) >> ScanN 20 '(Snd, Fst + Snd) Id >> Map Fst) "sdf"

-- Val [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765]

--

-- >>> pl @(ScanN 2 Succ Id) 4

-- Present [4,5,6] (Scanl [4,5,6] | b=4 | as=[1,2])

-- Val [4,5,6]

--

-- >>> pl @(ScanN 5 Id Id) 4

-- Present [4,4,4,4,4,4] (Scanl [4,4,4,4,4,4] | b=4 | as=[1,2,3,4,5])

-- Val [4,4,4,4,4,4]

--

-- >>> pl @(ScanN 2 Succ Id >> PadR 10 (MEmptyT Ordering) Id) LT

-- Present [LT,EQ,GT,EQ,EQ,EQ,EQ,EQ,EQ,EQ] ((>>) [LT,EQ,GT,EQ,EQ,EQ,EQ,EQ,EQ,EQ] | {PadR 10 pad=EQ [LT,EQ,GT,EQ,EQ,EQ,EQ,EQ,EQ,EQ] | [LT,EQ,GT]})

-- Val [LT,EQ,GT,EQ,EQ,EQ,EQ,EQ,EQ,EQ]

--

-- >>> pl @(ScanN 4 Pred Id) 99

-- Present [99,98,97,96,95] (Scanl [99,98,97,96,95] | b=99 | as=[1,2,3,4])

-- Val [99,98,97,96,95]

--

data ScanN n p q deriving Int -> ScanN n p q -> ShowS
[ScanN n p q] -> ShowS
ScanN n p q -> String
(Int -> ScanN n p q -> ShowS)
-> (ScanN n p q -> String)
-> ([ScanN n p q] -> ShowS)
-> Show (ScanN 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 -> ScanN n p q -> ShowS
forall k (n :: k) k (p :: k) k (q :: k). [ScanN n p q] -> ShowS
forall k (n :: k) k (p :: k) k (q :: k). ScanN n p q -> String
showList :: [ScanN n p q] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k) k (q :: k). [ScanN n p q] -> ShowS
show :: ScanN n p q -> String
$cshow :: forall k (n :: k) k (p :: k) k (q :: k). ScanN n p q -> String
showsPrec :: Int -> ScanN n p q -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k) k (q :: k).
Int -> ScanN n p q -> ShowS
Show
type ScanNT n p q = Scanl (Fst >> p) q (1...n) -- n times using q then run p


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

-- | tuple version of 'ScanN'

--

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

-- Present "abcde" (Scanl "abcde" | b='a' | as=[1,2,3,4])

-- Val "abcde"

--

-- >>> pl @(ScanNA Tail) (4,"abcd")

-- Present ["abcd","bcd","cd","d",""] (Scanl ["abcd","bcd","cd","d",""] | b="abcd" | as=[1,2,3,4])

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

--

-- >>> pl @(Len &&& Id >> ScanNA Tail) "abcd"

-- Present ["abcd","bcd","cd","d",""] ((>>) ["abcd","bcd","cd","d",""] | {Scanl ["abcd","bcd","cd","d",""] | b="abcd" | as=[1,2,3,4]})

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

--

data ScanNA q deriving Int -> ScanNA q -> ShowS
[ScanNA q] -> ShowS
ScanNA q -> String
(Int -> ScanNA q -> ShowS)
-> (ScanNA q -> String) -> ([ScanNA q] -> ShowS) -> Show (ScanNA q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (q :: k). Int -> ScanNA q -> ShowS
forall k (q :: k). [ScanNA q] -> ShowS
forall k (q :: k). ScanNA q -> String
showList :: [ScanNA q] -> ShowS
$cshowList :: forall k (q :: k). [ScanNA q] -> ShowS
show :: ScanNA q -> String
$cshow :: forall k (q :: k). ScanNA q -> String
showsPrec :: Int -> ScanNA q -> ShowS
$cshowsPrec :: forall k (q :: k). Int -> ScanNA q -> ShowS
Show
type ScanNAT q = ScanN Fst q Snd

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

-- | iterates n times keeping only the last result

--

-- >>> pz @(FoldN 4 Succ Id) 'c'

-- Val 'g'

--

-- >>> pz @(ReadP Day Id >> Id ... FoldN 5 Succ Id) "2020-07-27"

-- Val [2020-07-27,2020-07-28,2020-07-29,2020-07-30,2020-07-31,2020-08-01]

--

-- >>> pl @(FoldN 2 Succ Id) LT

-- Present GT ((>>) GT | {Last GT | [LT,EQ,GT]})

-- Val GT

--

-- >>> pl @(FoldN 30 Succ Id) LT

-- Error Succ IO e=Prelude.Enum.Ordering.succ: bad argument (Scanl)

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

--

-- >>> pl @(FoldN 6 Succ Id) 'a'

-- Present 'g' ((>>) 'g' | {Last 'g' | "abcdefg"})

-- Val 'g'

--

-- >>> pl @(FoldN 6 Pred Id) 'a'

-- Present '[' ((>>) '[' | {Last '[' | "a`_^]\\["})

-- Val '['

--

-- >>> pl @(FoldN 0 Succ Id) LT

-- Present LT ((>>) LT | {Last LT | [LT]})

-- Val LT

--

-- >>> pl @(FoldN 2 Succ Id >> FoldN 2 Pred Id) LT

-- Present LT ((>>) LT | {Last LT | [GT,EQ,LT]})

-- Val LT

--

-- >>> pz @(FoldN 4 (Id <> Id) Id) "abc" -- same as above

-- Val "abcabcabcabcabcabcabcabcabcabcabcabcabcabcabcabc"

--

data FoldN n p q deriving Int -> FoldN n p q -> ShowS
[FoldN n p q] -> ShowS
FoldN n p q -> String
(Int -> FoldN n p q -> ShowS)
-> (FoldN n p q -> String)
-> ([FoldN n p q] -> ShowS)
-> Show (FoldN 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 -> FoldN n p q -> ShowS
forall k (n :: k) k (p :: k) k (q :: k). [FoldN n p q] -> ShowS
forall k (n :: k) k (p :: k) k (q :: k). FoldN n p q -> String
showList :: [FoldN n p q] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k) k (q :: k). [FoldN n p q] -> ShowS
show :: FoldN n p q -> String
$cshow :: forall k (n :: k) k (p :: k) k (q :: k). FoldN n p q -> String
showsPrec :: Int -> FoldN n p q -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k) k (q :: k).
Int -> FoldN n p q -> ShowS
Show
type FoldNT n p q = ScanN n p q >> Last

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

-- | Foldl similar to 'foldl'

--

-- >>> pl @(Foldl (Fst + Snd) 0 (1 ... 10)) ()

-- Present 55 ((>>) 55 | {Last 55 | [0,1,3,6,10,15,21,28,36,45,55]})

-- Val 55

--

-- >>> pz @(Foldl (Snd :+ Fst) '[99] (1 ... 10)) ()

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

--

-- >>> pl @(Foldl Fst '() (EnumFromTo 1 9999)) ()

-- Error Scanl list size exceeded (max is 100)

-- Fail "Scanl list size exceeded"

--

-- >>> pl @(Foldl (Guard "someval" (Fst < Snd) >> Snd) Head Tail) [1,4,7,9,16]

-- Present 16 ((>>) 16 | {Last 16 | [1,4,7,9,16]})

-- Val 16

--

-- >>> pl @(Foldl (Guard (PrintT "%d not less than %d" Id) (Fst < Snd) >> Snd) Head Tail) [1,4,7,6,16]

-- Error 7 not less than 6 (Scanl)

-- Fail "7 not less than 6"

--

-- >>> pl @(Foldl (If (L11 && (Snd > L12)) '( 'True, Snd) '( 'False, L12)) '( 'True, Head) Tail) [1,4,7,9,16]

-- Present (True,16) ((>>) (True,16) | {Last (True,16) | [(True,1),(True,4),(True,7),(True,9),(True,16)]})

-- Val (True,16)

--

-- >>> pl @(Foldl (If (L11 && (Snd > L12)) '( 'True, Snd) '( 'False, L12)) '( 'True, Head) Tail) [1,4,7,9,16,2]

-- Present (False,16) ((>>) (False,16) | {Last (False,16) | [(True,1),(True,4),(True,7),(True,9),(True,16),(False,16)]})

-- Val (False,16)

--

-- >>> pl @(Foldl (Snd :+ Fst) (MEmptyT [_]) Id) [1..5]

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

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

--

-- >>> pl @('Just Uncons >> Foldl (If L11 (If (L12 < Snd) '( 'True,Snd) '( 'False, Snd)) Fst) '( 'True,Fst) Snd) [-10,-2,2,3,4,10,9,11]

-- Present (False,9) ((>>) (False,9) | {Last (False,9) | [(True,-10),(True,-2),(True,2),(True,3),(True,4),(True,10),(False,9),(False,9)]})

-- Val (False,9)

--

-- >>> pl @('Just Uncons >> Foldl (If L11 (If (L12 < Snd) '( 'True,Snd) '( 'False, Snd)) Fst) '( 'True,Fst) Snd) [-10,2,3,4,10,11]

-- Present (True,11) ((>>) (True,11) | {Last (True,11) | [(True,-10),(True,2),(True,3),(True,4),(True,10),(True,11)]})

-- Val (True,11)

--

data Foldl p q r deriving Int -> Foldl p q r -> ShowS
[Foldl p q r] -> ShowS
Foldl p q r -> String
(Int -> Foldl p q r -> ShowS)
-> (Foldl p q r -> String)
-> ([Foldl p q r] -> ShowS)
-> Show (Foldl 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 -> Foldl p q r -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). [Foldl p q r] -> ShowS
forall k (p :: k) k (q :: k) k (r :: k). Foldl p q r -> String
showList :: [Foldl p q r] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k) k (r :: k). [Foldl p q r] -> ShowS
show :: Foldl p q r -> String
$cshow :: forall k (p :: k) k (q :: k) k (r :: k). Foldl p q r -> String
showsPrec :: Int -> Foldl p q r -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k) k (r :: k).
Int -> Foldl p q r -> ShowS
Show
type FoldLT p q r = Scanl p q r >> Last

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

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

--

-- >>> pz @(Unfoldr (MaybeBool (Not Null) (SplitAt 2 Id)) Id) [1..5]

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

--

-- >>> pl @(Unfoldr (If Null (MkNothing _) ('(Take 3 Id, Drop 1 Id) >> MkJust Id)) Id) "abcdefghi"

-- Present ["abc","bcd","cde","def","efg","fgh","ghi","hi","i"] (Unfoldr "abcdefghi" ["abc","bcd","cde","def","efg","fgh","ghi","hi","i"] | s="abcdefghi")

-- Val ["abc","bcd","cde","def","efg","fgh","ghi","hi","i"]

--

-- >>> pl @(Unfoldr (If Null (MkNothing _) (Pure _ (SplitAt 2 Id))) Id) [1..5]

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

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

--

-- >>> pl @(Unfoldr (MaybeBool (Not Null) (SplitAt 2 Id)) Id) [1..5]

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

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

--

-- >>> pl @(Unfoldr (If Null (MkNothing _) (Guard "yy" (Len < 3) >> Pure _ (SplitAt 2 Id))) Id) [1..5]

-- Error yy (Unfoldr [1,2,3,4,5])

-- Fail "yy"

--

-- >>> pl @(Unfoldr (MaybeBool (Not Null) (Guard "yy" (Len < 3) >> SplitAt 2 Id)) Id) [1..5]

-- Error yy (Unfoldr [1,2,3,4,5])

-- Fail "yy"

--

-- >>> pl @(Unfoldr (Guard "xx" (Len > 4) >> Uncons) Id) [1..10]

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

-- Fail "xx"

--

-- >>> pl @(Unfoldr Uncons Id) [1..10]

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

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

--

-- >>> pan @(Unfoldr (If (Id < 1) (MkNothing _) (MkJust (DivMod Id 2 >> Swap))) Id) 8

-- P Unfoldr 8 [0,0,0,1]

-- |

-- +- P Id 8

-- |

-- +- P i=1: If 'False Just (0,4)

-- |

-- +- P i=2: If 'False Just (0,2)

-- |

-- +- P i=3: If 'False Just (0,1)

-- |

-- +- P i=4: If 'False Just (1,0)

-- |

-- `- P i=5: If 'True Nothing

-- Val [0,0,0,1]

--

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

instance ( PP q a ~ s
         , PP p s ~ Maybe (b,s)
         , P q a
         , P p s
         , Show s
         , Show b
         )
     => P (Unfoldr p q) a where
  type PP (Unfoldr p q) a = [UnfoldrT (PP p (PP q a))]
  eval :: proxy (Unfoldr p q) -> POpts -> a -> m (TT (PP (Unfoldr p q) a))
eval proxy (Unfoldr p q)
_ POpts
opts a
z = do
    let msg0 :: String
msg0 = String
"Unfoldr"
    TT s
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
z
    case Inline -> POpts -> String -> TT s -> [Tree PE] -> Either (TT [b]) s
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT s
qq [] 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 s
q -> 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 -> s -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts s
q
            ff :: Int
-> s
-> [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
-> m ([((Int, Maybe (b, s)), TT (Maybe (b, s)))],
      Either (TT [b]) ())
ff Int
i s
s [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
rs | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= POpts -> Int
getMaxRecursionValue POpts
opts = ([((Int, Maybe (b, s)), TT (Maybe (b, s)))], Either (TT [b]) ())
-> m ([((Int, Maybe (b, s)), TT (Maybe (b, s)))],
      Either (TT [b]) ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([((Int, Maybe (b, s)), TT (Maybe (b, s)))]
rs, TT [b] -> Either (TT [b]) ()
forall a b. a -> Either a b
Left (TT [b] -> Either (TT [b]) ()) -> TT [b] -> Either (TT [b]) ()
forall a b. (a -> b) -> a -> b
$ 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
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":recursion limit i=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i)) (String
"s=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> s -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts s
s) [])
                      | Bool
otherwise = do
                              pp :: TT (PP p s) <- POpts -> s -> m (TT (PP p s))
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p a) =>
POpts -> a -> m (TT (PP p a))
evalHide @p POpts
opts s
s
                              case Inline
-> POpts
-> String
-> TT (Maybe (b, s))
-> [Tree PE]
-> Either (TT [b]) (Maybe (b, s))
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
" i=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" s=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> s -> String
forall a. Show a => a -> String
show s
s) TT (Maybe (b, s))
TT (PP p s)
pp [] of
                                   Left TT [b]
e  -> ([((Int, Maybe (b, s)), TT (Maybe (b, s)))], Either (TT [b]) ())
-> m ([((Int, Maybe (b, s)), TT (Maybe (b, s)))],
      Either (TT [b]) ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([((Int, Maybe (b, s)), TT (Maybe (b, s)))]
rs, TT [b] -> Either (TT [b]) ()
forall a b. a -> Either a b
Left TT [b]
e)
                                   Right Maybe (b, s)
Nothing -> ([((Int, Maybe (b, s)), TT (Maybe (b, s)))], Either (TT [b]) ())
-> m ([((Int, Maybe (b, s)), TT (Maybe (b, s)))],
      Either (TT [b]) ())
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([((Int, Maybe (b, s)), TT (Maybe (b, s)))]
rs [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
-> [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
-> [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
forall a. [a] -> [a] -> [a]
++ [((Int
i,Maybe (b, s)
forall a. Maybe a
Nothing), TT (Maybe (b, s))
TT (PP p s)
pp)], () -> Either (TT [b]) ()
forall a b. b -> Either a b
Right ())
                                   Right w :: Maybe (b, s)
w@(Just (b
_b,s
s')) -> Int
-> s
-> [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
-> m ([((Int, Maybe (b, s)), TT (Maybe (b, s)))],
      Either (TT [b]) ())
ff (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) s
s' ([((Int, Maybe (b, s)), TT (Maybe (b, s)))]
rs [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
-> [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
-> [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
forall a. [a] -> [a] -> [a]
++ [((Int
i,Maybe (b, s)
w), TT (Maybe (b, s))
TT (PP p s)
pp)])
        (ts,lr) :: ([((Int, PP p s), TT (PP p s))], Either (TT [b]) ()) <- Int
-> s
-> [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
-> m ([((Int, Maybe (b, s)), TT (Maybe (b, s)))],
      Either (TT [b]) ())
ff Int
1 s
q []
        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 POpts
-> String
-> [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
-> Either
     (TT Any) [(Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))]
forall x a w.
Show x =>
POpts
-> String
-> [((Int, x), TT a)]
-> Either (TT w) [(a, (Int, x), TT a)]
splitAndAlign POpts
opts String
msg1 [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
[((Int, PP p s), TT (PP p s))]
ts of
             Left TT Any
e -> String -> TT [b]
forall x. HasCallStack => String -> x
errorInProgram (String -> TT [b]) -> String -> TT [b]
forall a b. (a -> b) -> a -> b
$ String
"Unfoldr e=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tree PE -> String
forall a. Show a => a -> String
show (TT Any -> Tree PE
forall a. TT a -> Tree PE
hh TT Any
e)
             Right [(Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))]
abcs ->
               let vals :: [Maybe (b, s)]
vals = ((Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
 -> Maybe (b, s))
-> [(Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))]
-> [Maybe (b, s)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting
  (Maybe (b, s))
  (Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
  (Maybe (b, s))
-> (Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
-> Maybe (b, s)
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
  (Maybe (b, s))
  (Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
  (Maybe (b, s))
forall s t a b. Field1 s t a b => Lens s t a b
_1) [(Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))]
abcs
                   itts :: [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
itts = ((Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
 -> ((Int, Maybe (b, s)), TT (Maybe (b, s))))
-> [(Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))]
-> [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
forall a b. (a -> b) -> [a] -> [b]
map (Getting
  (Int, Maybe (b, s))
  (Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
  (Int, Maybe (b, s))
-> (Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
-> (Int, Maybe (b, s))
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
  (Int, Maybe (b, s))
  (Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
  (Int, Maybe (b, s))
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
 -> (Int, Maybe (b, s)))
-> ((Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
    -> TT (Maybe (b, s)))
-> (Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
-> ((Int, Maybe (b, s)), TT (Maybe (b, s)))
forall (a :: Type -> Type -> Type) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting
  (TT (Maybe (b, s)))
  (Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
  (TT (Maybe (b, s)))
-> (Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
-> TT (Maybe (b, s))
forall s (m :: Type -> Type) a.
MonadReader s m =>
Getting a s a -> m a
view Getting
  (TT (Maybe (b, s)))
  (Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))
  (TT (Maybe (b, s)))
forall s t a b. Field3 s t a b => Lens s t a b
_3) [(Maybe (b, s), (Int, Maybe (b, s)), TT (Maybe (b, s)))]
abcs
               in case Either (TT [b]) ()
lr of
                   Left TT [b]
e -> POpts -> TT [b] -> String -> [Tree PE] -> TT [b]
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT [b]
e String
msg1 (TT s -> Tree PE
forall a. TT a -> Tree PE
hh TT s
qq Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: (((Int, Maybe (b, s)), TT (Maybe (b, s))) -> Tree PE)
-> [((Int, Maybe (b, s)), TT (Maybe (b, s)))] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT (Maybe (b, s)) -> Tree PE
forall a. TT a -> Tree PE
hh (TT (Maybe (b, s)) -> Tree PE)
-> (((Int, Maybe (b, s)), TT (Maybe (b, s))) -> TT (Maybe (b, s)))
-> ((Int, Maybe (b, s)), TT (Maybe (b, s)))
-> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Maybe (b, s)), TT (Maybe (b, s))) -> TT (Maybe (b, s))
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
itts)
                   Right () ->
                     let ret :: [b]
ret = (b, s) -> b
forall a b. (a, b) -> a
fst ((b, s) -> b) -> [(b, s)] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe (b, s)] -> [(b, s)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (b, s)]
vals
                     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 -> s -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> String -> a2 -> String
show3' POpts
opts String
msg1 [b]
ret String
"s=" s
q) (TT s -> Tree PE
forall a. TT a -> Tree PE
hh TT s
qq Tree PE -> [Tree PE] -> [Tree PE]
forall a. a -> [a] -> [a]
: (((Int, Maybe (b, s)), TT (Maybe (b, s))) -> Tree PE)
-> [((Int, Maybe (b, s)), TT (Maybe (b, s)))] -> [Tree PE]
forall a b. (a -> b) -> [a] -> [b]
map (TT (Maybe (b, s)) -> Tree PE
forall a. TT a -> Tree PE
hh (TT (Maybe (b, s)) -> Tree PE)
-> (((Int, Maybe (b, s)), TT (Maybe (b, s))) -> TT (Maybe (b, s)))
-> ((Int, Maybe (b, s)), TT (Maybe (b, s)))
-> Tree PE
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Maybe (b, s)), TT (Maybe (b, s))) -> TT (Maybe (b, s))
forall x a. ((Int, x), TT a) -> TT a
prefixNumberToTT) [((Int, Maybe (b, s)), TT (Maybe (b, s)))]
itts)

-- | calculate the return type for 'Unfoldr'

type family UnfoldrT (mbs :: Type) where
  UnfoldrT (Maybe (b, _)) = b
  UnfoldrT o = GL.TypeError (
      'GL.Text "UnfoldrT: expected 'Maybe (b, _)' "
      ':$$: 'GL.Text "o = "
      ':<>: 'GL.ShowType o)

-- | run @p@ @n@ times with state @s@

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

-- have to rewrite (a,s) to (a,(s,n)) hence the L11 ...

type IterateNT n p s = Unfoldr (MaybeBool (Snd > 0) ((p *** Pred) >> '(L11,'(L12,Snd)))) '(s,n)

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


-- | unfolds a value applying @f@ until the condition @p@ is true

--

-- >>> pl @(IterateUntil (Id < 90) Pred) 94

-- Present [94,93,92,91,90] (Unfoldr 94 [94,93,92,91,90] | s=94)

-- Val [94,93,92,91,90]

--

data IterateUntil p f deriving Int -> IterateUntil p f -> ShowS
[IterateUntil p f] -> ShowS
IterateUntil p f -> String
(Int -> IterateUntil p f -> ShowS)
-> (IterateUntil p f -> String)
-> ([IterateUntil p f] -> ShowS)
-> Show (IterateUntil p f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (f :: k). Int -> IterateUntil p f -> ShowS
forall k (p :: k) k (f :: k). [IterateUntil p f] -> ShowS
forall k (p :: k) k (f :: k). IterateUntil p f -> String
showList :: [IterateUntil p f] -> ShowS
$cshowList :: forall k (p :: k) k (f :: k). [IterateUntil p f] -> ShowS
show :: IterateUntil p f -> String
$cshow :: forall k (p :: k) k (f :: k). IterateUntil p f -> String
showsPrec :: Int -> IterateUntil p f -> ShowS
$cshowsPrec :: forall k (p :: k) k (f :: k). Int -> IterateUntil p f -> ShowS
Show
type IterateUntilT p f = IterateWhile (Not p) f

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

-- | unfolds a value applying @f@ while the condition @p@ is true

--

-- >>> pl @(IterateWhile (Id > 90) Pred) 94

-- Present [94,93,92,91] (Unfoldr 94 [94,93,92,91] | s=94)

-- Val [94,93,92,91]

--

data IterateWhile p f deriving Int -> IterateWhile p f -> ShowS
[IterateWhile p f] -> ShowS
IterateWhile p f -> String
(Int -> IterateWhile p f -> ShowS)
-> (IterateWhile p f -> String)
-> ([IterateWhile p f] -> ShowS)
-> Show (IterateWhile p f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (f :: k). Int -> IterateWhile p f -> ShowS
forall k (p :: k) k (f :: k). [IterateWhile p f] -> ShowS
forall k (p :: k) k (f :: k). IterateWhile p f -> String
showList :: [IterateWhile p f] -> ShowS
$cshowList :: forall k (p :: k) k (f :: k). [IterateWhile p f] -> ShowS
show :: IterateWhile p f -> String
$cshow :: forall k (p :: k) k (f :: k). IterateWhile p f -> String
showsPrec :: Int -> IterateWhile p f -> ShowS
$cshowsPrec :: forall k (p :: k) k (f :: k). Int -> IterateWhile p f -> ShowS
Show
type IterateWhileT p f = Unfoldr (MaybeBool p '(Id, f)) Id

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

-- | unfolds a value applying @f@ while the condition @p@ is true or @n@ times

--

-- >>> pl @(IterateNWhile 10 (Id > 90) Pred) 95

-- Present [95,94,93,92,91] ((>>) [95,94,93,92,91] | {Map [95,94,93,92,91] | [(10,95),(9,94),(8,93),(7,92),(6,91)]})

-- Val [95,94,93,92,91]

--

-- >>> pl @(IterateNWhile 3 (Id > 90) Pred) 95

-- Present [95,94,93] ((>>) [95,94,93] | {Map [95,94,93] | [(3,95),(2,94),(1,93)]})

-- Val [95,94,93]

--

data IterateNWhile n p f deriving Int -> IterateNWhile n p f -> ShowS
[IterateNWhile n p f] -> ShowS
IterateNWhile n p f -> String
(Int -> IterateNWhile n p f -> ShowS)
-> (IterateNWhile n p f -> String)
-> ([IterateNWhile n p f] -> ShowS)
-> Show (IterateNWhile n p f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k) k (p :: k) k (f :: k).
Int -> IterateNWhile n p f -> ShowS
forall k (n :: k) k (p :: k) k (f :: k).
[IterateNWhile n p f] -> ShowS
forall k (n :: k) k (p :: k) k (f :: k).
IterateNWhile n p f -> String
showList :: [IterateNWhile n p f] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k) k (f :: k).
[IterateNWhile n p f] -> ShowS
show :: IterateNWhile n p f -> String
$cshow :: forall k (n :: k) k (p :: k) k (f :: k).
IterateNWhile n p f -> String
showsPrec :: Int -> IterateNWhile n p f -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k) k (f :: k).
Int -> IterateNWhile n p f -> ShowS
Show
type IterateNWhileT n p f = '(n, Id) >> IterateWhile (Fst > 0 && (Snd >> p)) (Pred *** f) >> Map Snd

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

-- | unfolds a value applying @f@ until the condition @p@ is true or @n@ times

--

-- >>> pl @(IterateNUntil 10 (Id <= 90) Pred) 95

-- Present [95,94,93,92,91] ((>>) [95,94,93,92,91] | {Map [95,94,93,92,91] | [(10,95),(9,94),(8,93),(7,92),(6,91)]})

-- Val [95,94,93,92,91]

--

-- >>> pl @(IterateNUntil 3 (Id <= 90) Pred) 95

-- Present [95,94,93] ((>>) [95,94,93] | {Map [95,94,93] | [(3,95),(2,94),(1,93)]})

-- Val [95,94,93]

--

-- >>> pl @(IterateNUntil 9999 'False Id) 1

-- Error Unfoldr (9999,1):recursion limit i=100 (Unfoldr (9999,1))

-- Fail "Unfoldr (9999,1):recursion limit i=100"

--

data IterateNUntil n p f deriving Int -> IterateNUntil n p f -> ShowS
[IterateNUntil n p f] -> ShowS
IterateNUntil n p f -> String
(Int -> IterateNUntil n p f -> ShowS)
-> (IterateNUntil n p f -> String)
-> ([IterateNUntil n p f] -> ShowS)
-> Show (IterateNUntil n p f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k) k (p :: k) k (f :: k).
Int -> IterateNUntil n p f -> ShowS
forall k (n :: k) k (p :: k) k (f :: k).
[IterateNUntil n p f] -> ShowS
forall k (n :: k) k (p :: k) k (f :: k).
IterateNUntil n p f -> String
showList :: [IterateNUntil n p f] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k) k (f :: k).
[IterateNUntil n p f] -> ShowS
show :: IterateNUntil n p f -> String
$cshow :: forall k (n :: k) k (p :: k) k (f :: k).
IterateNUntil n p f -> String
showsPrec :: Int -> IterateNUntil n p f -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k) k (f :: k).
Int -> IterateNUntil n p f -> ShowS
Show
type IterateNUntilT n p f = IterateNWhile n (Not p) f

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

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

-- | runs values in parallel unlike 'Do' which is serial

--

-- >>> pz @(Para '[Id,Id + 1,Id * 4]) [10,20,30]

-- Val [10,21,120]

--

-- >>> pz @(Para '[Id,Id + 1,Id * 4]) [10,20,30,40]

-- Fail "Para:invalid length(4) expected 3"

--

-- >>> pl @(Para '[W 'True, Ge 12, W 'False, Lt 2]) [1,2,-99,-999]

-- Present [True,False,False,True] (Para(0) [True,False,False,True] | [1,2,-99,-999])

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

--

-- >>> pl @(Para '[W 'True, Ge 12, W 'False, Lt 2]) [1,2,-99]

-- Error Para:invalid length(3) expected 4

-- Fail "Para:invalid length(3) expected 4"

--

-- >>> pl @(Para '[W 'True, Ge 12, W 'False, Lt 2]) [1,2,-99,-999,1,1,2]

-- Error Para:invalid length(7) expected 4

-- Fail "Para:invalid length(7) expected 4"

--

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

-- passthru but adds the length of ps (replaces LenT in the type synonym to avoid type synonyms being expanded out

instance ( [a] ~ x
         , GetLen ps
         , P (ParaImpl (LenT ps) ps) x
         ) => P (Para ps) x where
  type PP (Para ps) x = PP (ParaImpl (LenT ps) ps) x
  eval :: proxy (Para ps) -> POpts -> x -> m (TT (PP (Para ps) x))
eval proxy (Para ps)
_ POpts
opts x
as' = do
    let msg0 :: String
msg0 = String
"Para"
        n :: Int
n = GetLen ps => Int
forall k (xs :: k). GetLen xs => Int
getLen @ps
    case POpts
-> String
-> [a]
-> [Tree PE]
-> Either (TT (PP (ParaImpl (LenT ps) ps) [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]
as' [] of
      Left TT (PP (ParaImpl (LenT ps) ps) [a])
e -> TT (PP (ParaImpl (LenT ps) ps) [a])
-> m (TT (PP (ParaImpl (LenT ps) ps) [a]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP (ParaImpl (LenT ps) ps) [a])
e
      Right (Int
asLen,[a]
as)
           | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
asLen -> Proxy (ParaImpl (LenT ps) ps)
-> POpts -> [a] -> m (TT (PP (ParaImpl (LenT ps) ps) [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 (ParaImpl (LenT ps) ps)
forall k (t :: k). Proxy t
Proxy @(ParaImpl (LenT ps) ps)) POpts
opts [a]
as
           | Bool
otherwise ->
               let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> Int -> String
badLength Int
asLen Int
n
               in TT (PP (ParaImpl (LenT ps) ps) [a])
-> m (TT (PP (ParaImpl (LenT ps) ps) [a]))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP (ParaImpl (LenT ps) ps) [a])
 -> m (TT (PP (ParaImpl (LenT ps) ps) [a])))
-> TT (PP (ParaImpl (LenT ps) ps) [a])
-> m (TT (PP (ParaImpl (LenT ps) ps) [a]))
forall a b. (a -> b) -> a -> b
$ POpts
-> Val (PP (ParaImpl (LenT ps) ps) [a])
-> String
-> [Tree PE]
-> TT (PP (ParaImpl (LenT ps) ps) [a])
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP (ParaImpl (LenT ps) ps) [a])
forall a. String -> Val a
Fail String
msg1) String
"" []

-- only allow non empty lists -- might need [a] ~ x but it seems fine

instance GL.TypeError ('GL.Text "ParaImpl '[] invalid: requires at least one value in the list")
   => P (ParaImpl n ('[] :: [k])) x where
  type PP (ParaImpl n ('[] :: [k])) x = Void
  eval :: proxy (ParaImpl n '[])
-> POpts -> x -> m (TT (PP (ParaImpl n '[]) x))
eval proxy (ParaImpl n '[])
_ POpts
_ x
_ = String -> m (TT Void)
forall x. HasCallStack => String -> x
errorInProgram String
"ParaImpl empty list"

instance ( KnownNat n
         , Show a
         , Show (PP p a)
         , P p a
         , x ~ [a]
         ) => P (ParaImpl n '[p]) x where
  type PP (ParaImpl n '[p]) x = [PP p (ExtractAFromTA x)]
  eval :: proxy (ParaImpl n '[p])
-> POpts -> x -> m (TT (PP (ParaImpl n '[p]) x))
eval proxy (ParaImpl n '[p])
_ POpts
opts x
as' = do
    let msgbase0 :: String
msgbase0 = String
"Para"
        msgbase1 :: String
msgbase1 = String
msgbase0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
        n :: Int
n = (KnownNat n, Num Int) => Int
forall (n :: Nat) a. (KnownNat n, Num a) => a
nat @n @Int
    case x
as' of
      [a] -> do
        TT (PP p a)
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
        TT [PP p a] -> 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
msgbase1 TT (PP p a)
pp [] of
          Left TT [PP p a]
e -> TT [PP p a]
e
          Right PP p a
b ->
            let ret :: [PP p a]
ret = [PP p a
b]
            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]
ret) (String
msgbase1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> [PP p a] -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts [PP p a]
ret 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
a) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]
      x
_ -> String -> m (TT [PP p a])
forall x. HasCallStack => String -> x
errorInProgram (String -> m (TT [PP p a])) -> String -> m (TT [PP p a])
forall a b. (a -> b) -> a -> b
$ String
"ParaImpl base case should have exactly one element but found " String -> ShowS
forall a. [a] -> [a] -> [a]
++ x -> String
forall a. Show a => a -> String
show x
as'

instance ( KnownNat n
         , GetLen ps
         , P p a
         , P (ParaImpl n (p1 ': ps)) x
         , PP (ParaImpl n (p1 ': ps)) x ~ [PP p a]
         , Show a
         , Show (PP p a)
         , x ~ [a]
         )
     => P (ParaImpl n (p ': p1 ': ps)) x where
  type PP (ParaImpl n (p ': p1 ': ps)) x = [PP p (ExtractAFromTA x)]

  eval :: proxy (ParaImpl n (p : p1 : ps))
-> POpts -> x -> m (TT (PP (ParaImpl n (p : p1 : ps)) x))
eval proxy (ParaImpl n (p : p1 : ps))
_ POpts
_ [] = String -> m (TT [PP p a])
forall x. HasCallStack => String -> x
errorInProgram String
"ParaImpl n+1 case has no data left"

  eval proxy (ParaImpl n (p : p1 : ps))
_ POpts
opts (a:as) = do
     let cpos :: Int
cpos = Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
         msgbase0 :: String
msgbase0 = String
"Para(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
cpos String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
         msgbase1 :: String
msgbase1 = String
"Para(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
cpos String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
         n :: Int
n = forall a. (KnownNat n, Num a) => a
forall (n :: Nat) a. (KnownNat n, Num a) => a
nat @n
         pos :: Int
pos = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ GetLen ps => Int
forall k (xs :: k). GetLen xs => Int
getLen @ps
     TT (PP p a)
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
     case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT [PP p a]) (PP p a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msgbase0 TT (PP p a)
pp [] 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 p a
b -> do
                    TT [PP p a]
qq <- Proxy (ParaImpl n (p1 : ps))
-> POpts -> [a] -> m (TT (PP (ParaImpl n (p1 : ps)) [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 (ParaImpl n (p1 : ps))
forall k (t :: k). Proxy t
Proxy @(ParaImpl n (p1 ': ps))) POpts
opts [a]
as
                    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
Inline POpts
opts String
"" TT [PP p a]
qq [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp] of
                      Left TT [PP p a]
e -> TT [PP p a]
e
                      Right [PP p a]
bs -> 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
bPP p a -> [PP p a] -> [PP p a]
forall a. a -> [a] -> [a]
:[PP p a]
bs)) (String
msgbase1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> [PP p a] -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts (PP p a
bPP p a -> [PP p a] -> [PP p a]
forall a. a -> [a] -> [a]
:[PP p a]
bs) 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
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
as)) [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]

-- | leverages 'Para' for repeating expressions (passthrough method)

--

-- >>> pz @(ParaN 4 Succ) [1..4]

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

--

-- >>> pz @(ParaN 4 Succ) "azwxm"

-- Fail "Para:invalid length(5) expected 4"

--

-- >>> pz @(ParaN 4 Succ) "azwx"

-- Val "b{xy"

--

-- >>> pl @(ParaN 5 (Guard "0-255" (Between 0 255 Id))) [1,2,3,4,12]

-- Present [1,2,3,4,12] (Para(0) [1,2,3,4,12] | [1,2,3,4,12])

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

--

-- >>> pl @(ParaN 5 (Guard "0-255" (Between 0 255 Id))) [1,2,3,400,12]

-- Error 0-255 (Guard | 400 | Para(3 of 4))

-- Fail "0-255"

--

-- >>> pz @(ParaN 5 (Guard (PrintF "bad value %d" Id) (Between 0 255 Id))) [1,2,3,400,12]

-- Fail "bad value 400"

--

-- >>> pl @(ParaN 4 (PrintF "%03d" Id)) [141,21,3,0]

-- Present ["141","021","003","000"] (Para(0) ["141","021","003","000"] | [141,21,3,0])

-- Val ["141","021","003","000"]

--

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

instance ( x ~ [a]
         , P (ParaImpl (LenT (RepeatT n p)) (RepeatT n p)) x
         , GetLen (RepeatT n p)
         ) => P (ParaN n p) x where
  type PP (ParaN n p) x = PP (Para (RepeatT n p)) x
  eval :: proxy (ParaN n p) -> POpts -> x -> m (TT (PP (ParaN n p) x))
eval proxy (ParaN n p)
_ = Proxy (Para (RepeatT n p))
-> POpts -> x -> m (TT (PP (Para (RepeatT 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 (Para (RepeatT n p))
forall k (t :: k). Proxy t
Proxy @(Para (RepeatT n p)))

-- | creates a promoted list of predicates and then evaluates them into a list. see PP instance for '[k]

--

-- >>> pz @(Repeat 4 Succ) 'c'

-- Val "dddd"

--

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

-- Val ["abc","abc","abc","abc"]

--

-- >>> pl @(Repeat 4 "xy") 3

-- Present ["xy","xy","xy","xy"] ('["xy","xy","xy","xy"] ('"xy") | 3)

-- Val ["xy","xy","xy","xy"]

--

data Repeat (n :: Nat) p deriving Int -> Repeat n p -> ShowS
[Repeat n p] -> ShowS
Repeat n p -> String
(Int -> Repeat n p -> ShowS)
-> (Repeat n p -> String)
-> ([Repeat n p] -> ShowS)
-> Show (Repeat n p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: Nat) k (p :: k). Int -> Repeat n p -> ShowS
forall (n :: Nat) k (p :: k). [Repeat n p] -> ShowS
forall (n :: Nat) k (p :: k). Repeat n p -> String
showList :: [Repeat n p] -> ShowS
$cshowList :: forall (n :: Nat) k (p :: k). [Repeat n p] -> ShowS
show :: Repeat n p -> String
$cshow :: forall (n :: Nat) k (p :: k). Repeat n p -> String
showsPrec :: Int -> Repeat n p -> ShowS
$cshowsPrec :: forall (n :: Nat) k (p :: k). Int -> Repeat n p -> ShowS
Show
instance P (RepeatT n p) a => P (Repeat n p) a where
  type PP (Repeat n p) a = PP (RepeatT n p) a
  eval :: proxy (Repeat n p) -> POpts -> a -> m (TT (PP (Repeat n p) a))
eval proxy (Repeat n p)
_ = Proxy (RepeatT n p) -> POpts -> a -> m (TT (PP (RepeatT n 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 (RepeatT n p)
forall k (t :: k). Proxy t
Proxy @(RepeatT n p))

-- | leverages 'Do' for repeating predicates (passthrough method)

-- same as @DoN n p == FoldN n p Id@ but more efficient

--

-- >>> pz @(DoN 4 Succ) 'c'

-- Val 'g'

--

-- >>> pz @(DoN 4 (Id <> " | ")) "abc"

-- Val "abc |  |  |  | "

--

-- >>> pz @(DoN 4 (Id <> "|" <> Id)) "abc"

-- Val "abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc|abc"

--

-- >>> pl @(DoN 4 (Id + 4)) 1

-- Present 17 ((>>) 17 | {13 + 4 = 17})

-- Val 17

--

-- >>> pl @(DoN 4 (Id + 7)) 3

-- Present 31 ((>>) 31 | {24 + 7 = 31})

-- Val 31

--

-- >>> pl @(DoN 4 9) ()

-- Present 9 ((>>) 9 | {'9})

-- Val 9

--

-- >>> pl @(DoN 4 "xy") 3

-- Present "xy" ((>>) "xy" | {'"xy"})

-- Val "xy"

--

data DoN (n :: Nat) p deriving Int -> DoN n p -> ShowS
[DoN n p] -> ShowS
DoN n p -> String
(Int -> DoN n p -> ShowS)
-> (DoN n p -> String) -> ([DoN n p] -> ShowS) -> Show (DoN n p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: Nat) k (p :: k). Int -> DoN n p -> ShowS
forall (n :: Nat) k (p :: k). [DoN n p] -> ShowS
forall (n :: Nat) k (p :: k). DoN n p -> String
showList :: [DoN n p] -> ShowS
$cshowList :: forall (n :: Nat) k (p :: k). [DoN n p] -> ShowS
show :: DoN n p -> String
$cshow :: forall (n :: Nat) k (p :: k). DoN n p -> String
showsPrec :: Int -> DoN n p -> ShowS
$cshowsPrec :: forall (n :: Nat) k (p :: k). Int -> DoN n p -> ShowS
Show
type DoNT (n :: Nat) p = Do (RepeatT n p)

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