{-# 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
, FoldMap
, ToListExt
, FromList
, FromListExt
, ToList
, IToList
, IToList'
, ToNEList
, 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))
import qualified Data.List.NonEmpty as N
import Data.List.NonEmpty (NonEmpty(..))
import qualified GHC.Exts as GE
import Data.List (findIndex)
import qualified Safe (cycleNote)
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 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 a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (t :: k). Int -> IToList' t -> ShowS
forall k (t :: k). [IToList' t] -> ShowS
forall k (t :: k). IToList' t -> String
showList :: [IToList' t] -> ShowS
$cshowList :: forall k (t :: k). [IToList' t] -> ShowS
show :: IToList' t -> String
$cshow :: forall k (t :: k). IToList' t -> String
showsPrec :: Int -> IToList' t -> ShowS
$cshowsPrec :: forall k (t :: k). Int -> IToList' t -> ShowS
Show
instance ( Show (f a)
, Typeable (PP t x)
, Show (PP t x)
, FoldableWithIndex (PP t x) f
, x ~ f a
, Show a
) => P (IToList' t) x where
type PP (IToList' t) x = [(PP t x, ExtractAFromTA x)]
eval :: proxy (IToList' t) -> POpts -> x -> m (TT (PP (IToList' t) x))
eval proxy (IToList' t)
_ POpts
opts x
x =
let msg0 :: String
msg0 = String
"IToList"
b :: [(PP t (f a), a)]
b = f a -> [(PP t (f a), a)]
forall i (f :: Type -> Type) a.
FoldableWithIndex i f =>
f a -> [(i, a)]
itoList x
f a
x
t :: String
t = Typeable (PP t x) => String
forall t. Typeable t => String
showT @(PP t x)
in TT [(PP t (f a), a)] -> m (TT [(PP t (f a), a)])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [(PP t (f a), a)] -> m (TT [(PP t (f a), a)]))
-> TT [(PP t (f a), a)] -> m (TT [(PP t (f a), a)])
forall a b. (a -> b) -> a -> b
$ POpts
-> Val [(PP t (f a), a)]
-> String
-> [Tree PE]
-> TT [(PP t (f a), a)]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([(PP t (f a), a)] -> Val [(PP t (f a), a)]
forall a. a -> Val a
Val [(PP t (f a), 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 (f a), a)] -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts [(PP t (f a), 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) []
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)
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 a
, Show x
, x ~ t [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 ( Show a
, Show (t a)
, PP p x ~ t a
, 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]) [a]
forall (t :: Type -> Type) a x.
Foldable t =>
POpts -> String -> t a -> [Tree PE] -> Either (TT x) [a]
chkSize POpts
opts String
msg0 t a
p [Tree PE]
hhs of
Left TT [a]
e -> TT [a]
e
Right [a]
_ ->
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 (String -> [a] -> [a]
forall a. Partial => String -> [a] -> [a]
Safe.cycleNote String
msg0 (t a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList t a
p))
in POpts -> Val [a] -> String -> [Tree PE] -> TT [a]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ([a] -> Val [a]
forall a. a -> Val a
Val [a]
d) (POpts -> String -> [a] -> t a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg1 [a]
d t a
p) [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 (t :: Type) p deriving Int -> FoldMap t p -> ShowS
[FoldMap t p] -> ShowS
FoldMap t p -> String
(Int -> FoldMap t p -> ShowS)
-> (FoldMap t p -> String)
-> ([FoldMap t p] -> ShowS)
-> Show (FoldMap t p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (p :: k). Int -> FoldMap t p -> ShowS
forall t k (p :: k). [FoldMap t p] -> ShowS
forall t k (p :: k). FoldMap t p -> String
showList :: [FoldMap t p] -> ShowS
$cshowList :: forall t k (p :: k). [FoldMap t p] -> ShowS
show :: FoldMap t p -> String
$cshow :: forall t k (p :: k). FoldMap t p -> String
showsPrec :: Int -> FoldMap t p -> ShowS
$cshowsPrec :: forall t k (p :: k). Int -> FoldMap t p -> ShowS
Show
type FoldMapT (t :: Type) p = Map' (Wrap t Id) p >> MConcat Id >> Unwrap
instance P (FoldMapT t p) x => P (FoldMap t p) x where
type PP (FoldMap t p) x = PP (FoldMapT t p) x
eval :: proxy (FoldMap t p) -> POpts -> x -> m (TT (PP (FoldMap t p) x))
eval proxy (FoldMap t p)
_ = Proxy (FoldMapT t p) -> POpts -> x -> m (TT (PP (FoldMapT t 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 (FoldMapT t p)
forall k (t :: k). Proxy t
Proxy @(FoldMapT t p))
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
, Show (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"
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 (t Bool -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length x
t Bool
x) 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 (t Bool -> [Bool]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList x
t 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 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 (t Bool -> Bool
forall (t :: Type -> Type). Foldable t => t Bool -> Bool
and x
t 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 -> x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " x
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
, Show x
, 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"
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 (t Bool -> Int
forall (t :: Type -> Type) a. Foldable t => t a -> Int
length x
t Bool
x) 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 (t Bool -> [Bool]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList x
t 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 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 (t Bool -> Bool
forall (t :: Type -> Type). Foldable t => t Bool -> Bool
or x
t 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 -> x -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " x
x) []