{-# 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 #-}
{-# LANGUAGE ViewPatterns #-}
module Predicate.Data.Foldable (
Concat
, ConcatMap
, Cycle
, FoldAla
, FoldMap
, ToListExt
, FromList
, FromListExt
, ToList
, IToList
, IToList'
, ToNEList
, OneP
, Null
, Null'
, IsEmpty
, Ands
, Ors
) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Predicate.Data.Monoid (MConcat)
import Control.Lens
import Data.Typeable (Typeable, Proxy(Proxy))
import Data.Kind (Type)
import Data.Foldable (Foldable(toList,fold))
import qualified Data.List.NonEmpty as N
import Data.List.NonEmpty (NonEmpty(..))
import qualified GHC.Exts as GE
import Data.List (findIndex)
data ToNEList deriving Int -> ToNEList -> ShowS
[ToNEList] -> ShowS
ToNEList -> String
(Int -> ToNEList -> ShowS)
-> (ToNEList -> String) -> ([ToNEList] -> ShowS) -> Show ToNEList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToNEList] -> ShowS
$cshowList :: [ToNEList] -> ShowS
show :: ToNEList -> String
$cshow :: ToNEList -> String
showsPrec :: Int -> ToNEList -> ShowS
$cshowsPrec :: Int -> ToNEList -> ShowS
Show
instance ( Show (t a)
, Foldable t
) => P ToNEList (t a) where
type PP ToNEList (t a) = NonEmpty a
eval :: proxy ToNEList -> POpts -> t a -> m (TT (PP ToNEList (t a)))
eval proxy ToNEList
_ POpts
opts t a
as =
let msg0 :: String
msg0 = String
"ToNEList"
in TT (NonEmpty a) -> m (TT (NonEmpty a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (NonEmpty a) -> m (TT (NonEmpty a)))
-> TT (NonEmpty a) -> m (TT (NonEmpty a))
forall a b. (a -> b) -> a -> b
$ case t a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList t a
as of
[] -> POpts -> Val (NonEmpty a) -> String -> [Tree PE] -> TT (NonEmpty a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (NonEmpty a)
forall a. String -> Val a
Fail String
"empty list") String
msg0 []
a
x:[a]
xs -> POpts -> Val (NonEmpty a) -> String -> [Tree PE] -> TT (NonEmpty a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (NonEmpty a -> Val (NonEmpty a)
forall a. a -> Val a
Val (a
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
N.:| [a]
xs)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> t a -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" " t a
as) []
data IsEmpty deriving Int -> IsEmpty -> ShowS
[IsEmpty] -> ShowS
IsEmpty -> String
(Int -> IsEmpty -> ShowS)
-> (IsEmpty -> String) -> ([IsEmpty] -> ShowS) -> Show IsEmpty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsEmpty] -> ShowS
$cshowList :: [IsEmpty] -> ShowS
show :: IsEmpty -> String
$cshow :: IsEmpty -> String
showsPrec :: Int -> IsEmpty -> ShowS
$cshowsPrec :: Int -> IsEmpty -> ShowS
Show
instance ( Show as
, AsEmpty as
) => P IsEmpty as where
type PP IsEmpty as = Bool
eval :: proxy IsEmpty -> POpts -> as -> m (TT (PP IsEmpty as))
eval proxy IsEmpty
_ POpts
opts as
as =
let b :: Bool
b = Getting Any as () -> as -> Bool
forall s a. Getting Any s a -> s -> Bool
has Getting Any as ()
forall a. AsEmpty a => Prism' a ()
_Empty as
as
in 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
$ POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
b (String
"IsEmpty" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> as -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " as
as) []
data IToList' t p deriving Int -> IToList' t p -> ShowS
[IToList' t p] -> ShowS
IToList' t p -> String
(Int -> IToList' t p -> ShowS)
-> (IToList' t p -> String)
-> ([IToList' t p] -> ShowS)
-> Show (IToList' t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k) k (p :: k). Int -> IToList' t p -> ShowS
forall k (t :: k) k (p :: k). [IToList' t p] -> ShowS
forall k (t :: k) k (p :: k). IToList' t p -> String
showList :: [IToList' t p] -> ShowS
$cshowList :: forall k (t :: k) k (p :: k). [IToList' t p] -> ShowS
show :: IToList' t p -> String
$cshow :: forall k (t :: k) k (p :: k). IToList' t p -> String
showsPrec :: Int -> IToList' t p -> ShowS
$cshowsPrec :: forall k (t :: k) k (p :: k). Int -> IToList' t p -> ShowS
Show
instance ( Typeable (PP t x)
, Show (PP t x)
, FoldableWithIndex (PP t x) f
, PP p x ~ f a
, P p x
, Show x
, Show a
) => P (IToList' t p) x where
type PP (IToList' t p) x = [(PP t x, ExtractAFromTA (PP p x))]
eval :: proxy (IToList' t p) -> POpts -> x -> m (TT (PP (IToList' t p) x))
eval proxy (IToList' t p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"IToList"
t :: String
t = Typeable (PP t x) => String
forall t. Typeable t => String
showT @(PP t x)
TT (f a)
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 t x, a)] -> m (TT [(PP t x, a)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(PP t x, a)] -> m (TT [(PP t x, a)]))
-> TT [(PP t x, a)] -> m (TT [(PP t x, a)])
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (f a)
-> [Tree PE]
-> Either (TT [(PP t x, a)]) (f a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (f a)
pp [] of
Left TT [(PP t x, a)]
e -> TT [(PP t x, a)]
e
Right f a
p ->
let b :: [(PP t x, a)]
b = f a -> [(PP t x, a)]
forall i (f :: Type -> Type) a.
FoldableWithIndex i f =>
f a -> [(i, a)]
itoList f a
p
in POpts
-> Val [(PP t x, a)] -> String -> [Tree PE] -> TT [(PP t x, a)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(PP t x, a)] -> Val [(PP t x, a)]
forall a. a -> Val a
Val [(PP t x, a)]
b) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
") " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> [(PP t x, a)] -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts [(PP t x, a)]
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " x
x) [TT (f a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (f a)
pp]
data IToList (t :: Type) deriving Int -> IToList t -> ShowS
[IToList t] -> ShowS
IToList t -> String
(Int -> IToList t -> ShowS)
-> (IToList t -> String)
-> ([IToList t] -> ShowS)
-> Show (IToList t)
forall t. Int -> IToList t -> ShowS
forall t. [IToList t] -> ShowS
forall t. IToList t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IToList t] -> ShowS
$cshowList :: forall t. [IToList t] -> ShowS
show :: IToList t -> String
$cshow :: forall t. IToList t -> String
showsPrec :: Int -> IToList t -> ShowS
$cshowsPrec :: forall t. Int -> IToList t -> ShowS
Show
type IToListT (t :: Type) = IToList' (Hole t) Id
instance P (IToListT t) x => P (IToList t) x where
type PP (IToList t) x = PP (IToListT t) x
eval :: proxy (IToList t) -> POpts -> x -> m (TT (PP (IToList t) x))
eval proxy (IToList t)
_ = Proxy (IToListT t) -> POpts -> x -> m (TT (PP (IToListT t) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (IToListT t)
forall k (t :: k). Proxy t
Proxy @(IToListT t))
data ToListExt deriving Int -> ToListExt -> ShowS
[ToListExt] -> ShowS
ToListExt -> String
(Int -> ToListExt -> ShowS)
-> (ToListExt -> String)
-> ([ToListExt] -> ShowS)
-> Show ToListExt
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToListExt] -> ShowS
$cshowList :: [ToListExt] -> ShowS
show :: ToListExt -> String
$cshow :: ToListExt -> String
showsPrec :: Int -> ToListExt -> ShowS
$cshowsPrec :: Int -> ToListExt -> ShowS
Show
instance ( Show l
, GE.IsList l
, Show (GE.Item l)
) => P ToListExt l where
type PP ToListExt l = [GE.Item l]
eval :: proxy ToListExt -> POpts -> l -> m (TT (PP ToListExt l))
eval proxy ToListExt
_ POpts
opts l
as =
let msg0 :: String
msg0 = String
"ToListExt"
z :: [Item l]
z = l -> [Item l]
forall l. IsList l => l -> [Item l]
GE.toList l
as
in TT [Item l] -> m (TT [Item l])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [Item l] -> m (TT [Item l])) -> TT [Item l] -> m (TT [Item l])
forall a b. (a -> b) -> a -> b
$ POpts -> Val [Item l] -> String -> [Tree PE] -> TT [Item l]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([Item l] -> Val [Item l]
forall a. a -> Val a
Val [Item l]
z) (POpts -> String -> [Item l] -> l -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 [Item l]
z l
as) []
data FromList (t :: Type) deriving Int -> FromList t -> ShowS
[FromList t] -> ShowS
FromList t -> String
(Int -> FromList t -> ShowS)
-> (FromList t -> String)
-> ([FromList t] -> ShowS)
-> Show (FromList t)
forall t. Int -> FromList t -> ShowS
forall t. [FromList t] -> ShowS
forall t. FromList t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromList t] -> ShowS
$cshowList :: forall t. [FromList t] -> ShowS
show :: FromList t -> String
$cshow :: forall t. FromList t -> String
showsPrec :: Int -> FromList t -> ShowS
$cshowsPrec :: forall t. Int -> FromList t -> ShowS
Show
instance ( a ~ GE.Item t
, Show t
, GE.IsList t
, [a] ~ x
) => P (FromList t) x where
type PP (FromList t) x = t
eval :: proxy (FromList t) -> POpts -> x -> m (TT (PP (FromList t) x))
eval proxy (FromList t)
_ POpts
opts x
as =
let msg0 :: String
msg0 = String
"FromList"
z :: t
z = [Item t] -> t
forall l. IsList l => [Item l] -> l
GE.fromList (x
[Item t]
as :: [GE.Item t]) :: t
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
z) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> t -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts t
z) []
data FromListExt (t :: Type) deriving Int -> FromListExt t -> ShowS
[FromListExt t] -> ShowS
FromListExt t -> String
(Int -> FromListExt t -> ShowS)
-> (FromListExt t -> String)
-> ([FromListExt t] -> ShowS)
-> Show (FromListExt t)
forall t. Int -> FromListExt t -> ShowS
forall t. [FromListExt t] -> ShowS
forall t. FromListExt t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromListExt t] -> ShowS
$cshowList :: forall t. [FromListExt t] -> ShowS
show :: FromListExt t -> String
$cshow :: forall t. FromListExt t -> String
showsPrec :: Int -> FromListExt t -> ShowS
$cshowsPrec :: forall t. Int -> FromListExt t -> ShowS
Show
instance ( Show l
, GE.IsList l
, l ~ l'
) => P (FromListExt l') l where
type PP (FromListExt l') l = l'
eval :: proxy (FromListExt l')
-> POpts -> l -> m (TT (PP (FromListExt l') l))
eval proxy (FromListExt l')
_ POpts
opts l
as =
let msg0 :: String
msg0 = String
"FromListExt"
z :: l'
z = [Item l'] -> l'
forall l. IsList l => [Item l] -> l
GE.fromList (l -> [Item l]
forall l. IsList l => l -> [Item l]
GE.toList @l l
as)
in TT l' -> m (TT l')
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT l' -> m (TT l')) -> TT l' -> m (TT l')
forall a b. (a -> b) -> a -> b
$ POpts -> Val l' -> String -> [Tree PE] -> TT l'
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (l' -> Val l'
forall a. a -> Val a
Val l'
z) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> l' -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts l'
z) []
data Concat deriving Int -> Concat -> ShowS
[Concat] -> ShowS
Concat -> String
(Int -> Concat -> ShowS)
-> (Concat -> String) -> ([Concat] -> ShowS) -> Show Concat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Concat] -> ShowS
$cshowList :: [Concat] -> ShowS
show :: Concat -> String
$cshow :: Concat -> String
showsPrec :: Int -> Concat -> ShowS
$cshowsPrec :: Int -> Concat -> ShowS
Show
instance ( Show x
, x ~ t [a]
, Show a
, Foldable t
) => P Concat x where
type PP Concat x = ExtractAFromTA x
eval :: proxy Concat -> POpts -> x -> m (TT (PP Concat x))
eval proxy Concat
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"Concat"
b :: [a]
b = t [a] -> [a]
forall (t :: Type -> Type) a. Foldable t => t [a] -> [a]
concat x
t [a]
x
in TT [a] -> m (TT [a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [a] -> m (TT [a])) -> TT [a] -> m (TT [a])
forall a b. (a -> b) -> a -> b
$ POpts -> Val [a] -> String -> [Tree PE] -> TT [a]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([a] -> Val [a]
forall a. a -> Val a
Val [a]
b) (POpts -> String -> [a] -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 [a]
b x
x) []
data ConcatMap p q deriving Int -> ConcatMap p q -> ShowS
[ConcatMap p q] -> ShowS
ConcatMap p q -> String
(Int -> ConcatMap p q -> ShowS)
-> (ConcatMap p q -> String)
-> ([ConcatMap p q] -> ShowS)
-> Show (ConcatMap p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> ConcatMap p q -> ShowS
forall k (p :: k) k (q :: k). [ConcatMap p q] -> ShowS
forall k (p :: k) k (q :: k). ConcatMap p q -> String
showList :: [ConcatMap p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [ConcatMap p q] -> ShowS
show :: ConcatMap p q -> String
$cshow :: forall k (p :: k) k (q :: k). ConcatMap p q -> String
showsPrec :: Int -> ConcatMap p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> ConcatMap p q -> ShowS
Show
type ConcatMapT p q = Map' p q >> Concat
instance P (ConcatMapT p q) x => P (ConcatMap p q) x where
type PP (ConcatMap p q) x = PP (ConcatMapT p q) x
eval :: proxy (ConcatMap p q)
-> POpts -> x -> m (TT (PP (ConcatMap p q) x))
eval proxy (ConcatMap p q)
_ = Proxy (ConcatMapT p q)
-> POpts -> x -> m (TT (PP (ConcatMapT 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 (ConcatMapT p q)
forall k (t :: k). Proxy t
Proxy @(ConcatMapT p q))
data Cycle n p deriving Int -> Cycle n p -> ShowS
[Cycle n p] -> ShowS
Cycle n p -> String
(Int -> Cycle n p -> ShowS)
-> (Cycle n p -> String)
-> ([Cycle n p] -> ShowS)
-> Show (Cycle n p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (n :: k) k (p :: k). Int -> Cycle n p -> ShowS
forall k (n :: k) k (p :: k). [Cycle n p] -> ShowS
forall k (n :: k) k (p :: k). Cycle n p -> String
showList :: [Cycle n p] -> ShowS
$cshowList :: forall k (n :: k) k (p :: k). [Cycle n p] -> ShowS
show :: Cycle n p -> String
$cshow :: forall k (n :: k) k (p :: k). Cycle n p -> String
showsPrec :: Int -> Cycle n p -> ShowS
$cshowsPrec :: forall k (n :: k) k (p :: k). Int -> Cycle n p -> ShowS
Show
instance ( PP p x ~ t a
, Show x
, P p x
, Integral (PP n x)
, P n x
, Foldable t
) => P (Cycle n p) x where
type PP (Cycle n p) x = [ExtractAFromTA (PP p x)]
eval :: proxy (Cycle n p) -> POpts -> x -> m (TT (PP (Cycle n p) x))
eval proxy (Cycle n p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Cycle"
Either (TT [a]) (PP n x, t a, TT (PP n x), TT (t a))
lr <- Inline
-> String
-> Proxy n
-> Proxy p
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT [a]) (PP n x, PP p x, TT (PP n 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 n
forall k (t :: k). Proxy t
Proxy @n) (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]) (PP n x, t a, TT (PP n x), TT (t a))
lr of
Left TT [a]
e -> TT [a]
e
Right (PP n x -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n,t a
p,TT (PP n x)
nn,TT (t a)
pp) ->
let hhs :: [Tree PE]
hhs = [TT (PP n x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP n x)
nn, TT (t a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t a)
pp]
in case POpts -> String -> t 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 t a
p [Tree PE]
hhs of
Left TT [a]
e -> TT [a]
e
Right (Int
_,[a]
ps) ->
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
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
d :: [a]
d = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n ([a] -> [a]
forall a. [a] -> [a]
cycle' [a]
ps)
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 -> x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
msg1 x
x) [Tree PE]
hhs
data ToList deriving Int -> ToList -> ShowS
[ToList] -> ShowS
ToList -> String
(Int -> ToList -> ShowS)
-> (ToList -> String) -> ([ToList] -> ShowS) -> Show ToList
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToList] -> ShowS
$cshowList :: [ToList] -> ShowS
show :: ToList -> String
$cshow :: ToList -> String
showsPrec :: Int -> ToList -> ShowS
$cshowsPrec :: Int -> ToList -> ShowS
Show
instance ( Show (t a)
, Foldable t
) => P ToList (t a) where
type PP ToList (t a) = [a]
eval :: proxy ToList -> POpts -> t a -> m (TT (PP ToList (t a)))
eval proxy ToList
_ POpts
opts t a
as =
let msg0 :: String
msg0 = String
"ToList"
z :: [a]
z = t a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList t 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]
z) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> t a -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" " t a
as) []
data Null' p deriving Int -> Null' p -> ShowS
[Null' p] -> ShowS
Null' p -> String
(Int -> Null' p -> ShowS)
-> (Null' p -> String) -> ([Null' p] -> ShowS) -> Show (Null' p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> Null' p -> ShowS
forall k (p :: k). [Null' p] -> ShowS
forall k (p :: k). Null' p -> String
showList :: [Null' p] -> ShowS
$cshowList :: forall k (p :: k). [Null' p] -> ShowS
show :: Null' p -> String
$cshow :: forall k (p :: k). Null' p -> String
showsPrec :: Int -> Null' p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> Null' p -> ShowS
Show
instance ( Show (t a)
, Foldable t
, t a ~ PP p x
, P p x
) => P (Null' p) x where
type PP (Null' p) x = Bool
eval :: proxy (Null' p) -> POpts -> x -> m (TT (PP (Null' p) x))
eval proxy (Null' p)
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"Null"
TT (t a)
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 Bool -> m (TT Bool)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Bool -> m (TT Bool)) -> TT Bool -> m (TT Bool)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (t a)
-> [Tree PE]
-> Either (TT Bool) (t a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (t a)
pp [] of
Left TT Bool
e -> TT Bool
e
Right t a
p ->
let b :: Bool
b = t a -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null t a
p
in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts Bool
b (String
"Null" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> t a -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " t a
p) [TT (t a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (t a)
pp]
data Null deriving Int -> Null -> ShowS
[Null] -> ShowS
Null -> String
(Int -> Null -> ShowS)
-> (Null -> String) -> ([Null] -> ShowS) -> Show Null
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Null] -> ShowS
$cshowList :: [Null] -> ShowS
show :: Null -> String
$cshow :: Null -> String
showsPrec :: Int -> Null -> ShowS
$cshowsPrec :: Int -> Null -> ShowS
Show
type NullT = Null' Id
instance P NullT a => P Null a where
type PP Null a = Bool
eval :: proxy Null -> POpts -> a -> m (TT (PP Null a))
eval proxy Null
_ = Proxy NullT -> POpts -> a -> m (TT (PP NullT a))
forall k (m :: Type -> Type) (p :: k) a (proxy :: k -> Type).
(MonadEval m, P p a, PP p a ~ Bool) =>
proxy p -> POpts -> a -> m (TT (PP p a))
evalBool (Proxy NullT
forall k (t :: k). Proxy t
Proxy @NullT)
data FoldMap p deriving Int -> FoldMap p -> ShowS
[FoldMap p] -> ShowS
FoldMap p -> String
(Int -> FoldMap p -> ShowS)
-> (FoldMap p -> String)
-> ([FoldMap p] -> ShowS)
-> Show (FoldMap p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> FoldMap p -> ShowS
forall k (p :: k). [FoldMap p] -> ShowS
forall k (p :: k). FoldMap p -> String
showList :: [FoldMap p] -> ShowS
$cshowList :: forall k (p :: k). [FoldMap p] -> ShowS
show :: FoldMap p -> String
$cshow :: forall k (p :: k). FoldMap p -> String
showsPrec :: Int -> FoldMap p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> FoldMap p -> ShowS
Show
instance ( Traversable n
, Monoid t
, PP p a ~ t
, P p a
) => P (FoldMap p) (n a) where
type PP (FoldMap p) (n a) = PP p a
eval :: proxy (FoldMap p) -> POpts -> n a -> m (TT (PP (FoldMap p) (n a)))
eval proxy (FoldMap p)
_ POpts
opts n a
na = do
let msg0 :: String
msg0 = String
"FoldMap"
n (TT t)
nttb <- (a -> m (TT t)) -> n a -> m (n (TT t))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
((TT t -> TT t) -> m (TT t) -> m (TT t)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\TT t
tt -> TT t
tt TT t -> (TT t -> TT t) -> TT t
forall a b. a -> (a -> b) -> b
& (String -> Identity String) -> TT t -> Identity (TT t)
forall a. Lens' (TT a) String
ttString ((String -> Identity String) -> TT t -> Identity (TT t))
-> ShowS -> TT t -> TT t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ POpts -> ShowS
litL POpts
opts
TT t -> (TT t -> TT t) -> TT t
forall a b. a -> (a -> b) -> b
& ([Tree PE] -> Identity [Tree PE]) -> TT t -> Identity (TT t)
forall a. Lens' (TT a) [Tree PE]
ttForest (([Tree PE] -> Identity [Tree PE]) -> TT t -> Identity (TT t))
-> [Tree PE] -> TT t -> TT t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [TT t -> Tree PE
forall a. TT a -> Tree PE
hh TT t
tt]) (m (TT t) -> m (TT t)) -> (a -> m (TT t)) -> a -> m (TT t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts)
n a
na
let ttnb :: TT (n t)
ttnb = n (TT t) -> TT (n t)
forall (t :: Type -> Type) (f :: Type -> Type) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA n (TT t)
nttb
TT t -> m (TT t)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT t -> m (TT t)) -> TT t -> m (TT t)
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts -> String -> TT (n t) -> [Tree PE] -> Either (TT t) (n t)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
Inline POpts
opts String
"" TT (n t)
ttnb [] of
Left TT t
e -> TT t
e
Right n t
ret ->
let ind :: String
ind = case (t -> [t]) -> n t -> [t]
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap t -> [t]
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure n t
ret of
[] -> String
" <skipped>"
t
_:[t]
_ -> String
""
d :: t
d = n t -> t
forall (t :: Type -> Type) m. (Foldable t, Monoid m) => t m -> m
fold n t
ret
in TT (n t)
ttnb TT (n t) -> (TT (n t) -> TT t) -> TT t
forall a b. a -> (a -> b) -> b
& (Val (n t) -> Identity (Val t)) -> TT (n t) -> Identity (TT t)
forall a b. Lens (TT a) (TT b) (Val a) (Val b)
ttVal ((Val (n t) -> Identity (Val t)) -> TT (n t) -> Identity (TT t))
-> Val t -> TT (n t) -> TT t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ t -> Val t
forall a. a -> Val a
Val t
d
TT t -> (TT t -> TT t) -> TT t
forall a b. a -> (a -> b) -> b
& (String -> Identity String) -> TT t -> Identity (TT t)
forall a. Lens' (TT a) String
ttString ((String -> Identity String) -> TT t -> Identity (TT t))
-> ShowS -> TT t -> TT t
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
ind String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
nullIf String
" "
data FoldAla (t :: Type) deriving Int -> FoldAla t -> ShowS
[FoldAla t] -> ShowS
FoldAla t -> String
(Int -> FoldAla t -> ShowS)
-> (FoldAla t -> String)
-> ([FoldAla t] -> ShowS)
-> Show (FoldAla t)
forall t. Int -> FoldAla t -> ShowS
forall t. [FoldAla t] -> ShowS
forall t. FoldAla t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FoldAla t] -> ShowS
$cshowList :: forall t. [FoldAla t] -> ShowS
show :: FoldAla t -> String
$cshow :: forall t. FoldAla t -> String
showsPrec :: Int -> FoldAla t -> ShowS
$cshowsPrec :: forall t. Int -> FoldAla t -> ShowS
Show
type FoldAlaT (t :: Type) = Map' (Wrap t Id) Id >> MConcat >> Unwrap
instance P (FoldAlaT t) x => P (FoldAla t) x where
type PP (FoldAla t) x = PP (FoldAlaT t) x
eval :: proxy (FoldAla t) -> POpts -> x -> m (TT (PP (FoldAla t) x))
eval proxy (FoldAla t)
_ = Proxy (FoldAlaT t) -> POpts -> x -> m (TT (PP (FoldAlaT t) x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy (FoldAlaT t)
forall k (t :: k). Proxy t
Proxy @(FoldAlaT t))
data Ands deriving Int -> Ands -> ShowS
[Ands] -> ShowS
Ands -> String
(Int -> Ands -> ShowS)
-> (Ands -> String) -> ([Ands] -> ShowS) -> Show Ands
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ands] -> ShowS
$cshowList :: [Ands] -> ShowS
show :: Ands -> String
$cshow :: Ands -> String
showsPrec :: Int -> Ands -> ShowS
$cshowsPrec :: Int -> Ands -> ShowS
Show
instance ( x ~ t a
, Foldable t
, a ~ Bool
) => P Ands x where
type PP Ands x = Bool
eval :: proxy Ands -> POpts -> x -> m (TT (PP Ands x))
eval proxy Ands
_ POpts
opts x
x' =
let msg0 :: String
msg0 = String
"Ands"
in 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 POpts
-> String -> t Bool -> [Tree PE] -> Either (TT Bool) (Int, [Bool])
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
t Bool
x' [] of
Left TT Bool
e -> TT Bool
e
Right (Int
xLen,[Bool]
x) ->
let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
xLen String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
w :: String
w = case (Bool -> Bool) -> [Bool] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex Bool -> Bool
not [Bool]
x of
Maybe Int
Nothing -> String
""
Just Int
i -> String
" i="String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
i
in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts ([Bool] -> Bool
forall (t :: Type -> Type). Foldable t => t Bool -> Bool
and [Bool]
x) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
w String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [Bool] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " [Bool]
x) []
data Ors deriving Int -> Ors -> ShowS
[Ors] -> ShowS
Ors -> String
(Int -> Ors -> ShowS)
-> (Ors -> String) -> ([Ors] -> ShowS) -> Show Ors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ors] -> ShowS
$cshowList :: [Ors] -> ShowS
show :: Ors -> String
$cshow :: Ors -> String
showsPrec :: Int -> Ors -> ShowS
$cshowsPrec :: Int -> Ors -> ShowS
Show
instance ( x ~ t a
, Foldable t
, a ~ Bool
) => P Ors x where
type PP Ors x = Bool
eval :: proxy Ors -> POpts -> x -> m (TT (PP Ors x))
eval proxy Ors
_ POpts
opts x
x' =
let msg0 :: String
msg0 = String
"Ors"
in 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 POpts
-> String -> t Bool -> [Tree PE] -> Either (TT Bool) (Int, [Bool])
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
t Bool
x' [] of
Left TT Bool
e -> TT Bool
e
Right (Int
xLen,[Bool]
x) ->
let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
xLen String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
w :: String
w = case (Bool -> Bool) -> [Bool] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex Bool -> Bool
forall a. a -> a
id [Bool]
x of
Maybe Int
Nothing -> String
""
Just Int
i -> String
" i="String -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show Int
i
in POpts -> Bool -> String -> [Tree PE] -> TT Bool
mkNodeB POpts
opts ([Bool] -> Bool
forall (t :: Type -> Type). Foldable t => t Bool -> Bool
or [Bool]
x) (String
msg1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
w String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [Bool] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " [Bool]
x) []
data OneP deriving Int -> OneP -> ShowS
[OneP] -> ShowS
OneP -> String
(Int -> OneP -> ShowS)
-> (OneP -> String) -> ([OneP] -> ShowS) -> Show OneP
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OneP] -> ShowS
$cshowList :: [OneP] -> ShowS
show :: OneP -> String
$cshow :: OneP -> String
showsPrec :: Int -> OneP -> ShowS
$cshowsPrec :: Int -> OneP -> ShowS
Show
instance ( Foldable t
, x ~ t a
) => P OneP x where
type PP OneP x = ExtractAFromTA x
eval :: proxy OneP -> POpts -> x -> m (TT (PP OneP x))
eval proxy OneP
_ POpts
opts x
x = do
let msg0 :: String
msg0 = String
"OneP"
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 t a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList x
t a
x of
[] -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":expected one element(empty)")) String
"" []
[a
a] -> POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (a -> Val a
forall a. a -> Val a
Val a
a) String
msg0 []
[a]
as' -> 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]
as' [] of
Left TT a
e -> TT a
e
Right (Int
asLen,[a]
_) ->
POpts -> Val a -> String -> [Tree PE] -> TT a
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val a
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
":expected one element(" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
asLen String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")")) String
"" []