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

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

-- >>> import Predicate.Prelude

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XAllowAmbiguousTypes

-- >>> :set -XOverloadedStrings

-- >>> :set -XNoOverloadedLists

-- >>> :set -XFlexibleContexts

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

-- >>> import qualified Data.Set as Set

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

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

-- >>> import Data.These

-- >>> import Data.Time


-- | create a 'NonEmpty' list from a 'Foldable'

--

-- >>> pz @ToNEList []

-- Fail "empty list"

--

-- >>> pz @ToNEList [1,2,3,4,5]

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

--

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


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


-- | similar to 'null' using 'AsEmpty'

--

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

-- Val False

--

-- >>> pz @IsEmpty []

-- Val True

--

-- >>> pz @IsEmpty LT

-- Val False

--

-- >>> pz @IsEmpty EQ

-- Val True

--

-- >>> pl @IsEmpty ("failed11" :: T.Text)

-- False (IsEmpty | "failed11")

-- Val False

--

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

-- True (IsEmpty | "")

-- Val True

--

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

-- | explicit version of 'IToList' with an extra parameter @p@ to point to the value

--

-- >>> pz @(IToList' (Hole _) Snd) (True,"aBc" :: String)

-- Val [(0,'a'),(1,'B'),(2,'c')]

--

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]

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

--

-- >>> pz @(IToList _) ("aBc" :: String)

-- Val [(0,'a'),(1,'B'),(2,'c')]

--

-- >>> pl @(IToList _) ("abcd" :: String)

-- Present [(0,'a'),(1,'b'),(2,'c'),(3,'d')] (IToList(Int) [(0,'a'),(1,'b'),(2,'c'),(3,'d')] | "abcd")

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

--

-- >>> pl @(IToList _) (M.fromList $ itoList ("abcd" :: String))

-- Present [(0,'a'),(1,'b'),(2,'c'),(3,'d')] (IToList(Int) [(0,'a'),(1,'b'),(2,'c'),(3,'d')] | fromList [(0,'a'),(1,'b'),(2,'c'),(3,'d')])

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

--

-- >>> pl @(IToList _) [9,2,7,4]

-- Present [(0,9),(1,2),(2,7),(3,4)] (IToList(Int) [(0,9),(1,2),(2,7),(3,4)] | [9,2,7,4])

-- Val [(0,9),(1,2),(2,7),(3,4)]

--

-- >>> pl @(IToList _) (M.fromList (zip ['a'..] [9,2,7,4]))

-- Present [('a',9),('b',2),('c',7),('d',4)] (IToList(Char) [('a',9),('b',2),('c',7),('d',4)] | fromList [('a',9),('b',2),('c',7),('d',4)])

-- Val [('a',9),('b',2),('c',7),('d',4)]

--

-- >>> pl @(IToList _) (Just 234)

-- Present [((),234)] (IToList(()) [((),234)] | Just 234)

-- Val [((),234)]

--

-- >>> pl @(IToList _) (Nothing @Double)

-- Present [] (IToList(()) [] | Nothing)

-- Val []

--

-- >>> pl @(IToList _) [1..5]

-- Present [(0,1),(1,2),(2,3),(3,4),(4,5)] (IToList(Int) [(0,1),(1,2),(2,3),(3,4),(4,5)] | [1,2,3,4,5])

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

--

-- >>> pl @(IToList _) ['a','b','c']

-- Present [(0,'a'),(1,'b'),(2,'c')] (IToList(Int) [(0,'a'),(1,'b'),(2,'c')] | "abc")

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

--

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

-- | invokes 'GE.toList'

--

-- >>> pz @ToListExt (M.fromList [(1,'x'),(4,'y')])

-- Val [(1,'x'),(4,'y')]

--

-- >>> pz @ToListExt (T.pack "abc")

-- Val "abc"

--

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

-- | invokes 'GE.fromList'

--

-- >>> run @('OMsg "Fred" ':# 'OLite ':# 'OColorOff) @(FromList (Set.Set Int) << '[2,1,5,5,2,5,2]) ()

-- Fred >>> Present fromList [1,2,5] ((>>) fromList [1,2,5] | {FromList fromList [1,2,5]})

-- Val (fromList [1,2,5])

--

-- >>> pl @(FromList (M.Map _ _) >> Id !! C "y") [('x',True),('y',False)]

-- Present False ((>>) False | {IxL('y') False | p=fromList [('x',True),('y',False)] | q='y'})

-- Val False

--

-- >>> pl @(FromList (M.Map _ _) >> Id !! C "z") [('x',True),('y',False)]

-- Error (!!) index not found (IxL('z') | fromList [('x',True),('y',False)])

-- Fail "(!!) index not found"

--

-- >>> pl @(FromList (M.Map _ _)) [(4,"x"),(5,"dd")]

-- Present fromList [(4,"x"),(5,"dd")] (FromList fromList [(4,"x"),(5,"dd")])

-- Val (fromList [(4,"x"),(5,"dd")])

--

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
-- doesnt work with OverloadedLists unless you cast to [a] explicitly


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

-- | invokes 'GE.fromList'

--

-- requires the OverloadedLists extension

--

-- >>> :set -XOverloadedLists

-- >>> pz @(FromListExt (M.Map _ _)) [(4,"x"),(5,"dd")]

-- Val (fromList [(4,"x"),(5,"dd")])

--

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
-- l ~ l' is key

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

-- | similar to 'concat'

--

-- >>> pz @Concat (Just "abc")

-- Val "abc"

--

-- >>> pz @Concat (Left 123)

-- Val []

--

-- >>> pz @Concat ["abc","D","eF","","G"]

-- Val "abcDeFG"

--

-- >>> pz @(Snd >> Concat) ('x',["abc","D","eF","","G"])

-- Val "abcDeFG"

--

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

-- | similar to 'concatMap'

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


-- | similar to 'cycle' but for a fixed number @n@: for an empty list it just returns an empty list

--

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

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

--

-- >>> pz @(Cycle 5 Id) []

-- Val []

--

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

-- | similar to 'toList'

--

-- >>> pz @ToList "aBc"

-- Val "aBc"

--

-- >>> pz @ToList (Just 14)

-- Val [14]

--

-- >>> pz @ToList Nothing

-- Val []

--

-- >>> pz @ToList (Left "xx")

-- Val []

--

-- >>> pz @ToList (These 12 "xx")

-- Val ["xx"]

--

-- >>> pl @ToList (M.fromList $ zip [0..] "abcd")

-- Present "abcd" (ToList fromList [(0,'a'),(1,'b'),(2,'c'),(3,'d')])

-- Val "abcd"

--

-- >>> pl @ToList (Just 123)

-- Present [123] (ToList Just 123)

-- Val [123]

--

-- >>> pl @ToList (M.fromList (zip ['a'..] [9,2,7,4]))

-- Present [9,2,7,4] (ToList fromList [('a',9),('b',2),('c',7),('d',4)])

-- Val [9,2,7,4]

--

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

-- | explicit version of 'Null' with an extra parameter @p@ to point to the value

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]

-- | similar to 'null' using 'Foldable'

--

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

-- Val False

--

-- >>> pz @Null []

-- Val True

--

-- >>> pz @Null Nothing

-- Val True

--

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)

-- | similar to 'Data.Foldable.foldMap'

--

-- >>> pl @(FoldMap (Wrap (SG.Sum _) Id)) (Left "x")

-- Present Sum {getSum = 0} (FoldMap <skipped>)

-- Val (Sum {getSum = 0})

--

-- >>> pz @(FoldMap (Wrap (SG.Sum _) Id)) [1..5]

-- Val (Sum {getSum = 15})

--

-- >>> pl @(FoldMap (Wrap (SG.Sum _) Id)) (Right 123)

-- Present Sum {getSum = 123} (FoldMap Wrap Sum {getSum = 123} | 123)

-- Val (Sum {getSum = 123})

--

-- >>> pl @(FoldMap (Map Len)) (Just ["abc","defg","h"])

-- Present [3,4,1] (FoldMap Map [3,4,1] | ["abc","defg","h"])

-- Val [3,4,1]

--

-- >>> pz @(FoldMap (Map Len)) (Just ["abc","defg","h"])

-- Val [3,4,1]

--

-- >>> pz @(FoldMap (Wrap (SG.Sum _) Len)) ["abc","defg","h"]

-- Val (Sum {getSum = 8})

--

-- >>> pz @(FoldMap (FoldMap (Wrap (SG.Sum _) Id))) (Just [1..10])

-- Val (Sum {getSum = 55})

--

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

-- | wraps each item in the foldable container and then unwraps the mconcatenated result: uses 'Control.Lens.Wrapped.Wrapped'

--

-- >>> pz @(FoldAla (SG.Sum _)) [44, 12, 3]

-- Val 59

--

-- >>> pz @(FoldAla (SG.Product _)) [44, 12, 3]

-- Val 1584

--

-- >>> type Ands' = FoldAla SG.All

-- >>> pz @Ands' [True,False,True,True]

-- Val False

--

-- >>> pz @Ands' [True,True,True]

-- Val True

--

-- >>> pz @Ands' []

-- Val True

--

-- >>> type Ors' = FoldAla SG.Any

-- >>> pz @Ors' [False,False,False]

-- Val False

--

-- >>> pz @Ors' []

-- Val False

--

-- >>> pz @Ors' [False,False,False,True]

-- Val True

--

-- >>> type AllPositive' = Map Positive >> FoldAla SG.All

-- >>> pz @AllPositive' [3,1,-5,10,2,3]

-- Val False

--

-- >>> type AllNegative' = Map Negative >> FoldAla SG.All

-- >>> pz @AllNegative' [-1,-5,-10,-2,-3]

-- Val True

--

-- >>> :set -XKindSignatures

-- >>> type Max' (t :: Type) = FoldAla (SG.Max t) -- requires t be Bounded for monoid instance

-- >>> pz @(Max' Int) [10,4,5,12,3,4]

-- Val 12

--

-- >>> pl @(FoldAla (SG.Sum _)) [14,8,17,13]

-- Present 52 ((>>) 52 | {getSum = 52})

-- Val 52

--

-- >>> pl @(FoldAla (SG.Max _)) [14 :: Int,8,17,13] -- allowed as the values are Bounded!

-- Present 17 ((>>) 17 | {getMax = 17})

-- Val 17

--

-- >>> pl @((Len >> (Elem Id '[4,7,1] || (Mod Id 3 >> Same 0))) || (FoldAla (SG.Sum _) >> Gt 200)) [1..20]

-- True (False || True)

-- Val True

--

-- >>> pl @((Len >> (Elem Id '[4,7,1] || (Mod Id 3 >> Same 0))) || (FoldAla (SG.Sum _) >> Gt 200)) [1..19]

-- False (False || False | ((>>) False | {1 == 0}) || ((>>) False | {190 > 200}))

-- Val False

--

-- >>> pl @((Len >> (Elem Id '[4,7,1] || (Mod Id 3 >> Same 0))) || (FoldAla (SG.Sum _) >> Gt 200)) []

-- True (True || False)

-- Val True

--

-- >>> pl @((Len >> (Elem Id '[4,7,1] || (Mod Id 3 >> Same 0))) &&& FoldAla (SG.Sum _)) [1..20]

-- Present (False,210) ('(False,210))

-- Val (False,210)

--

-- >>> pl @(FoldAla SG.Any) [False,False,True,False]

-- Present True ((>>) True | {getAny = True})

-- Val True

--

-- >>> pl @(FoldAla SG.All) [False,False,True,False]

-- Present False ((>>) False | {getAll = False})

-- Val False

--

-- >>> pl @(FoldAla (SG.Sum _)) (Just 13)

-- Present 13 ((>>) 13 | {getSum = 13})

-- Val 13

--

-- >>> pl @(FoldAla (SG.Sum _)) [1..10]

-- Present 55 ((>>) 55 | {getSum = 55})

-- Val 55

--

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

-- | similar to 'Data.Foldable.and'

--

-- >>> pz @Ands [True,True,True]

-- Val True

--

-- >>> pl @Ands [True,True,True,False]

-- False (Ands(4) i=3 | [True,True,True,False])

-- Val False

--

-- >>> pz @Ands []

-- Val True

--

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

-- | similar to 'Data.Foldable.or'

--

-- >>> pz @Ors [False,False,False]

-- Val False

--

-- >>> pl @Ors [True,True,True,False]

-- True (Ors(4) i=0 | [True,True,True,False])

-- Val True

--

-- >>> pl @Ors []

-- False (Ors(0) | [])

-- Val False

--

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

-- | gets the singleton value from a foldable

--

-- >>> pl @OneP [10..15]

-- Error OneP:expected one element(6)

-- Fail "OneP:expected one element(6)"

--

-- >>> pl @OneP [10]

-- Present 10 (OneP)

-- Val 10

--

-- >>> pl @OneP []

-- Error OneP:expected one element(empty)

-- Fail "OneP:expected one element(empty)"

--

-- >>> pl @OneP (Just 10)

-- Present 10 (OneP)

-- Val 10

--

-- >>> pl @OneP Nothing

-- Error OneP:expected one element(empty)

-- Fail "OneP:expected one element(empty)"

--

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

--type OneP = Guard "expected list of length 1" (Len == 1) >> Head

--type OneP = Guard (PrintF "expected list of length 1 but found length=%d" Len) (Len == 1) >> Head