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

module Predicate.Data.Enum (

  -- ** constructors

    type (...)
  , EnumFromTo
  , EnumFromThenTo
  , FromEnum
  , FromEnum'
  , Universe
  , Universe'

  -- ** bounded enums

  , SuccB
  , SuccB'
  , PredB
  , PredB'
  , ToEnumBDef
  , ToEnumBDef'
  , ToEnumBFail

  -- ** unsafe enums

  , Succ
  , SuccN
  , Pred
  , ToEnum
  , ToEnum'
 ) where
import Predicate.Core
import Predicate.Util
import Safe (succMay, predMay, toEnumMay)
import Data.Proxy (Proxy(..))
import Data.Kind (Type)
import Data.Tree (Tree)
import Control.Lens (under,enum)
-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XOverloadedStrings

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

-- >>> import Predicate

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

-- >>> import Data.Time


-- | bounded 'succ' function

--

-- >>> pz @(SuccB 'LT Id) GT

-- Val LT

--

-- >>> pz @(SuccB 'LT 'GT) ()

-- Val LT

--

-- >>> pz @(SuccB 'GT 'LT) ()

-- Val EQ

--

-- >>> pl @(SuccB 'LT Id) GT

-- Present LT (SuccB out of range)

-- Val LT

--

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

instance ( PP q x ~ a
         , P q x
         , P p (Proxy a)
         , PP p (Proxy a) ~ a
         , Show a
         , Eq a
         , Bounded a
         , Enum a
         ) => P (SuccB p q) x where
  type PP (SuccB p q) x = PP q x
  eval :: proxy (SuccB p q) -> POpts -> x -> m (TT (PP (SuccB p q) x))
eval proxy (SuccB p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"SuccB"
    TT a
qq <- Proxy q -> POpts -> x -> m (TT (PP q x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x
    case Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT a) a
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT a
qq [] of
      Left TT a
e -> TT a -> m (TT a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT a
e
      Right a
q ->
        case a -> Maybe a
forall a. (Enum a, Eq a, Bounded a) => a -> Maybe a
succMay a
q of
          Maybe a
Nothing -> POpts -> String -> Tree PE -> m (TT a)
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p (Proxy a), PP p (Proxy a) ~ a) =>
POpts -> String -> Tree PE -> m (TT a)
_enumDefault @p @a POpts
opts String
msg0 (TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
qq)
          Just a
n -> 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
n) (POpts -> String -> a -> a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 a
n a
q) [TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
qq]

_enumDefault :: forall p a m
  . ( MonadEval m
    , P p (Proxy a)
    , PP p (Proxy a) ~ a
    )
  => POpts
  -> String
  -> Tree PE
  -> m (TT a)
_enumDefault :: POpts -> String -> Tree PE -> m (TT a)
_enumDefault POpts
opts String
msg0 Tree PE
hhqq = do
   let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" out of range"
   TT a
pp <- Proxy p -> POpts -> Proxy a -> m (TT (PP p (Proxy 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 (Proxy a
forall k (t :: k). Proxy t
Proxy @a)
   TT a -> m (TT a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT a -> m (TT a)) -> TT a -> m (TT a)
forall a b. (a -> b) -> a -> b
$ case Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT a) a
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg1 TT a
pp [Tree PE
hhqq] of
     Left TT a
e -> TT a
e
     Right a
_ -> POpts -> TT a -> String -> [Tree PE] -> TT a
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT a
pp String
msg1 [Tree PE
hhqq]

-- | bounded 'succ' function

--

-- >>> pz @(SuccB' Id) GT

-- Fail "Succ bounded"

--

-- >>> pz @(SuccB' Id) (13 :: Int)

-- Val 14

--

-- >>> pz @(SuccB' Id) LT

-- Val EQ

--

data SuccB' q deriving Int -> SuccB' q -> ShowS
[SuccB' q] -> ShowS
SuccB' q -> String
(Int -> SuccB' q -> ShowS)
-> (SuccB' q -> String) -> ([SuccB' q] -> ShowS) -> Show (SuccB' q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (q :: k). Int -> SuccB' q -> ShowS
forall k (q :: k). [SuccB' q] -> ShowS
forall k (q :: k). SuccB' q -> String
showList :: [SuccB' q] -> ShowS
$cshowList :: forall k (q :: k). [SuccB' q] -> ShowS
show :: SuccB' q -> String
$cshow :: forall k (q :: k). SuccB' q -> String
showsPrec :: Int -> SuccB' q -> ShowS
$cshowsPrec :: forall k (q :: k). Int -> SuccB' q -> ShowS
Show
type SuccBT' q = SuccB (FailP "Succ bounded") q

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

-- | bounded 'pred' function

--

-- >>> pz @(PredB' Id) (13 :: Int)

-- Val 12

--

-- >>> pz @(PredB' Id) LT

-- Fail "Pred bounded"

--

-- >>> pl @(PredB' Id) GT

-- Present EQ (PredB EQ | GT)

-- Val EQ

--

-- >>> pl @(PredB' Id) LT

-- Error Pred bounded (PredB out of range)

-- Fail "Pred bounded"

--


data PredB' q deriving Int -> PredB' q -> ShowS
[PredB' q] -> ShowS
PredB' q -> String
(Int -> PredB' q -> ShowS)
-> (PredB' q -> String) -> ([PredB' q] -> ShowS) -> Show (PredB' q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (q :: k). Int -> PredB' q -> ShowS
forall k (q :: k). [PredB' q] -> ShowS
forall k (q :: k). PredB' q -> String
showList :: [PredB' q] -> ShowS
$cshowList :: forall k (q :: k). [PredB' q] -> ShowS
show :: PredB' q -> String
$cshow :: forall k (q :: k). PredB' q -> String
showsPrec :: Int -> PredB' q -> ShowS
$cshowsPrec :: forall k (q :: k). Int -> PredB' q -> ShowS
Show
type PredBT' q = PredB (FailP "Pred bounded") q

instance ( PP q x ~ a
         , P q x
         , P p (Proxy a)
         , PP p (Proxy a) ~ a
         , Show a
         , Eq a
         , Bounded a
         , Enum a
         ) => P (PredB p q) x where
  type PP (PredB p q) x = PP q x
  eval :: proxy (PredB p q) -> POpts -> x -> m (TT (PP (PredB p q) x))
eval proxy (PredB p q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"PredB"
    TT a
qq <- Proxy q -> POpts -> x -> m (TT (PP q x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
x
    case Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT a) a
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT a
qq [] of
      Left TT a
e -> TT a -> m (TT a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT a
e
      Right a
q ->
        case a -> Maybe a
forall a. (Enum a, Eq a, Bounded a) => a -> Maybe a
predMay a
q of
          Maybe a
Nothing -> POpts -> String -> Tree PE -> m (TT a)
forall k (p :: k) a (m :: Type -> Type).
(MonadEval m, P p (Proxy a), PP p (Proxy a) ~ a) =>
POpts -> String -> Tree PE -> m (TT a)
_enumDefault @p @a POpts
opts String
msg0 (TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
qq)
          Just a
n -> 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
n) (POpts -> String -> a -> a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 a
n a
q) [TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
qq]


-- | unbounded 'succ' function

--

-- >>> pz @Succ 13

-- Val 14

--

-- >>> pz @Succ LT

-- Val EQ

--

-- >>> pz @Succ GT

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

--

-- >>> pl @Succ 10

-- Present 11 (Succ 11 | 10)

-- Val 11

--

-- >>> pl @Succ True -- captures the exception

-- Error Succ IO e=Prelude.Enum.Bool.succ: bad argument (True)

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

--

-- >>> pz @Succ (Proxy @44)

-- Fail "Succ IO e=Proxy.succ"

--

data Succ deriving Int -> Succ -> ShowS
[Succ] -> ShowS
Succ -> String
(Int -> Succ -> ShowS)
-> (Succ -> String) -> ([Succ] -> ShowS) -> Show Succ
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Succ] -> ShowS
$cshowList :: [Succ] -> ShowS
show :: Succ -> String
$cshow :: Succ -> String
showsPrec :: Int -> Succ -> ShowS
$cshowsPrec :: Int -> Succ -> ShowS
Show
{-
>print $! (succ Proxy) -- need to force this to get an exception
*** Exception: Proxy.succ
-}
instance ( Show x
         , Enum x
         ) => P Succ x where
  type PP Succ x = x
  eval :: proxy Succ -> POpts -> x -> m (TT (PP Succ x))
eval proxy Succ
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"Succ"
    Either String x
lr <- x -> m (Either String x)
forall (m :: Type -> Type) a.
MonadEval m =>
a -> m (Either String a)
catchit (x -> x
forall a. Enum a => a -> a
succ x
x)
    TT x -> m (TT x)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT x -> m (TT x)) -> TT x -> m (TT x)
forall a b. (a -> b) -> a -> b
$ case Either String x
lr of
      Left String
e -> POpts -> Val x -> String -> [Tree PE] -> TT x
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val x
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e)) (POpts -> x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts x
x) []
      Right x
n -> POpts -> Val x -> String -> [Tree PE] -> TT x
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (x -> Val x
forall a. a -> Val a
Val x
n) (POpts -> String -> x -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 x
n x
x) []

-- | SuccN n p (unsafe) increments an enum p by the given integral n

--

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

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

--

-- >>> pz @(ReadP Day Id >> SuccN (Negate 5) Id) "2020-07-27"

-- Val 2020-07-22

--

-- >>> pl @(SuccN 3 'LT) ()

-- Error SuccN IO e=Prelude.Enum.Ordering.toEnum: bad argument (SuccN 3 LT)

-- Fail "SuccN IO e=Prelude.Enum.Ordering.toEnum: bad argument"

--

-- >>> pz @(SuccN 2 'LT) ()

-- Val GT

--

-- >>> pz @(SuccN (Negate 3) (C "x")) ()

-- Val 'u'

--

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

instance ( Show a
         , Enum a
         , Integral (PP n x)
         , P n x
         , PP p x ~ a
         , P p x
         ) => P (SuccN n p) x where
  type PP (SuccN n p) x = PP p x
  eval :: proxy (SuccN n p) -> POpts -> x -> m (TT (PP (SuccN n p) x))
eval proxy (SuccN n p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"SuccN"
    Either (TT a) (PP n x, a, TT (PP n x), TT 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 []
    case Either (TT a) (PP n x, a, TT (PP n x), TT a)
lr of
      Left TT a
e -> TT a -> m (TT a)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT a
e
      Right (PP n x -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n :: Int,a
p,TT (PP n x)
nn,TT a
pp) -> do
        Either String a
lr1 <- a -> m (Either String a)
forall (m :: Type -> Type) a.
MonadEval m =>
a -> m (Either String a)
catchit (AnIso Int Int a a -> (Int -> Int) -> a -> a
forall s t a b. AnIso s t a b -> (t -> s) -> b -> a
under AnIso Int Int a a
forall a. Enum a => Iso' Int a
enum (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) a
p)
        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 String a
lr1 of
          Left String
e -> 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
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e)) (POpts -> ShowS
litL POpts
opts (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
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
p)) [TT (PP n x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP n x)
nn, TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
pp]
          Right a
r -> 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
r) (POpts -> ShowS
litL POpts
opts (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
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
p)) [TT (PP n x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP n x)
nn, TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
pp]


-- | unbounded 'pred' function

--

-- >>> pz @Pred 13

-- Val 12

--

-- >>> pz @Pred LT

-- Fail "Pred IO e=Prelude.Enum.Ordering.pred: bad argument"

--

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

instance ( Show x
         , Enum x
         ) => P Pred x where
  type PP Pred x = x
  eval :: proxy Pred -> POpts -> x -> m (TT (PP Pred x))
eval proxy Pred
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"Pred"
    Either String x
lr <- x -> m (Either String x)
forall (m :: Type -> Type) a.
MonadEval m =>
a -> m (Either String a)
catchit (x -> x
forall a. Enum a => a -> a
pred x
x)
    TT x -> m (TT x)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT x -> m (TT x)) -> TT x -> m (TT x)
forall a b. (a -> b) -> a -> b
$ case Either String x
lr of
      Left String
e -> POpts -> Val x -> String -> [Tree PE] -> TT x
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val x
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e)) (POpts -> x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts x
x) []
      Right x
n -> POpts -> Val x -> String -> [Tree PE] -> TT x
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (x -> Val x
forall a. a -> Val a
Val x
n) (POpts -> String -> x -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 x
n x
x) []

-- | bounded 'pred' function

--

-- >>> pl @(PredB 'GT Id) LT

-- Present GT (PredB out of range)

-- Val GT

--

-- >>> pl @(PredB 'LT Id) GT

-- Present EQ (PredB EQ | GT)

-- Val EQ

--

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

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


-- | 'fromEnum' function

--

-- >>> pz @(FromEnum' Id) 'x'

-- Val 120

--

-- >>> pl @(FromEnum' ("aa" ==! Id) >> Same 1) "aaaa"

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

-- Val False

--

-- >>> pl @(FromEnum' ("aa" ==! Id) >> ToEnum OrderingP) "aaaa"

-- Present CGt ((>>) CGt | {ToEnum CGt | 0})

-- Val CGt

--

-- >>> pl @(Map (FromEnum' Id) >> Map (ToEnum Char)) "abcd"

-- Present "abcd" ((>>) "abcd" | {Map "abcd" | [97,98,99,100]})

-- Val "abcd"

--

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

instance ( Show a
         , Enum a
         , PP p x ~ a
         , P p x
         ) => P (FromEnum' p) x where
  type PP (FromEnum' p) x = Int
  eval :: proxy (FromEnum' p) -> POpts -> x -> m (TT (PP (FromEnum' p) x))
eval proxy (FromEnum' p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"FromEnum"
    TT 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 Int -> m (TT Int)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Int -> m (TT Int)) -> TT Int -> m (TT Int)
forall a b. (a -> b) -> a -> b
$ case Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT Int) a
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT a
pp [] of
      Left TT Int
e -> TT Int
e
      Right a
p ->
        let n :: Int
n = a -> Int
forall a. Enum a => a -> Int
fromEnum a
p
        in POpts -> Val Int -> String -> [Tree PE] -> TT Int
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Int -> Val Int
forall a. a -> Val a
Val Int
n) (POpts -> String -> Int -> a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 Int
n a
p) [TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
pp]

-- | 'fromEnum' function

--

-- >>> pz @FromEnum 'x'

-- Val 120

--

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

instance ( Show x
         , Enum x
         ) => P FromEnum x where
  type PP FromEnum x = Int
  eval :: proxy FromEnum -> POpts -> x -> m (TT (PP FromEnum x))
eval proxy FromEnum
_ POpts
opts x
x =
    let msg0 :: String
msg0 = String
"FromEnum"
        n :: Int
n = x -> Int
forall a. Enum a => a -> Int
fromEnum x
x
    in TT Int -> m (TT Int)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Int -> m (TT Int)) -> TT Int -> m (TT Int)
forall a b. (a -> b) -> a -> b
$ POpts -> Val Int -> String -> [Tree PE] -> TT Int
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Int -> Val Int
forall a. a -> Val a
Val Int
n) (POpts -> String -> Int -> x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 Int
n x
x) []


-- | unsafe 'toEnum' function that allows you to specify the target @p@ and a pointer to a type @t@

--

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

instance ( PP p x ~ a
         , P p x
         , Enum (PP t x)
         , Show (PP t x)
         , Integral a
         ) => P (ToEnum' t p) x where
  type PP (ToEnum' t p) x = PP t x
  eval :: proxy (ToEnum' t p) -> POpts -> x -> m (TT (PP (ToEnum' t p) x))
eval proxy (ToEnum' t p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ToEnum"
    TT 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
    case Inline
-> POpts -> String -> TT a -> [Tree PE] -> Either (TT (PP t x)) a
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT a
pp [] of
      Left TT (PP t x)
e -> TT (PP t x) -> m (TT (PP t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP t x)
e
      Right (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
p) -> do
        Either String (PP t x)
lr <- PP t x -> m (Either String (PP t x))
forall (m :: Type -> Type) a.
MonadEval m =>
a -> m (Either String a)
catchit (Int -> PP t x
forall a. Enum a => Int -> a
toEnum Int
p)
        TT (PP t x) -> m (TT (PP t x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t x) -> m (TT (PP t x))) -> TT (PP t x) -> m (TT (PP t x))
forall a b. (a -> b) -> a -> b
$ case Either String (PP t x)
lr of
          Left String
e -> POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP t x)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
e)) (POpts -> Int -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Int
p) [TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
pp]
          Right PP t x
n -> POpts -> Val (PP t x) -> String -> [Tree PE] -> TT (PP t x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t x -> Val (PP t x)
forall a. a -> Val a
Val PP t x
n) (POpts -> String -> PP t x -> Int -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP t x
n Int
p) [TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
pp]

-- | unsafe 'toEnum' function

--

-- >>> pz @(ToEnum Char) 120

-- Val 'x'

--

-- >>> pl @(Map FromEnum >> Map (Id - 97 >> ToEnum Ordering)) "abcde"

-- Error ToEnum IO e=Prelude.Enum.Ordering.toEnum: bad argument(2) (Map(i=3, a=100) excnt=2)

-- Fail "ToEnum IO e=Prelude.Enum.Ordering.toEnum: bad argument(2)"

--

-- >>> pl @((ToEnum Day *** ToEnum Day) >> EnumFromTo Fst Snd) (0,5)

-- Present [1858-11-17,1858-11-18,1858-11-19,1858-11-20,1858-11-21,1858-11-22] ((>>) [1858-11-17,1858-11-18,1858-11-19,1858-11-20,1858-11-21,1858-11-22] | {1858-11-17 ... 1858-11-22})

-- Val [1858-11-17,1858-11-18,1858-11-19,1858-11-20,1858-11-21,1858-11-22]

--

-- >>> pz @(ToEnum (Proxy ())) 0

-- Val Proxy

--

-- >>> pz @(ToEnum (Proxy ())) 1

-- Fail "ToEnum IO e=Proxy.toEnum: 0 expected"

--

-- >>> pz @(ToEnum (Proxy "sss") >> Pop0 Id ()) 0

-- Val "sss"

--

data ToEnum (t :: Type) deriving Int -> ToEnum t -> ShowS
[ToEnum t] -> ShowS
ToEnum t -> String
(Int -> ToEnum t -> ShowS)
-> (ToEnum t -> String) -> ([ToEnum t] -> ShowS) -> Show (ToEnum t)
forall t. Int -> ToEnum t -> ShowS
forall t. [ToEnum t] -> ShowS
forall t. ToEnum t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToEnum t] -> ShowS
$cshowList :: forall t. [ToEnum t] -> ShowS
show :: ToEnum t -> String
$cshow :: forall t. ToEnum t -> String
showsPrec :: Int -> ToEnum t -> ShowS
$cshowsPrec :: forall t. Int -> ToEnum t -> ShowS
Show
type ToEnumT (t :: Type) = ToEnum' (Hole t) Id

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

-- | bounded 'toEnum' function where @t@ refers to location of the type and @p@ the location of the input

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

instance ( P def (Proxy (PP t a))
         , PP def (Proxy (PP t a)) ~ PP t a
         , Show (PP t a)
         , Show a
         , Bounded (PP t a)
         , Enum (PP t a)
         , Integral (PP p a)
         , P p a
         ) => P (ToEnumBDef' t def p) a where
  type PP (ToEnumBDef' t def p) a = PP t a
  eval :: proxy (ToEnumBDef' t def p)
-> POpts -> a -> m (TT (PP (ToEnumBDef' t def p) a))
eval proxy (ToEnumBDef' t def p)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"ToEnumBDef"
    TT (PP p a)
pp <- Proxy p -> POpts -> a -> m (TT (PP p a))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy p
forall k (t :: k). Proxy t
Proxy @p) POpts
opts a
a
    case Inline
-> POpts
-> String
-> TT (PP p a)
-> [Tree PE]
-> Either (TT (PP t a)) (PP p a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p a)
pp [] of
      Left TT (PP t a)
e -> TT (PP t a) -> m (TT (PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT (PP t a)
e
      Right (PP p a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
p) -> do
        case Int -> Maybe (PP t a)
forall a. (Enum a, Bounded a) => Int -> Maybe a
toEnumMay Int
p of
          Maybe (PP t a)
Nothing -> do
             let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" out of range"
             TT (PP t a)
dd <- Proxy def
-> POpts -> Proxy (PP t a) -> m (TT (PP def (Proxy (PP t 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 def
forall k (t :: k). Proxy t
Proxy @def) POpts
opts (Proxy (PP t a)
forall k (t :: k). Proxy t
Proxy @(PP t a))
             TT (PP t a) -> m (TT (PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t a) -> m (TT (PP t a))) -> TT (PP t a) -> m (TT (PP t a))
forall a b. (a -> b) -> a -> b
$ case Inline
-> POpts
-> String
-> TT (PP t a)
-> [Tree PE]
-> Either (TT (PP t a)) (PP t a)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg1 TT (PP t a)
dd [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp] of
               Left TT (PP t a)
e -> TT (PP t a)
e
               Right PP t a
_ -> POpts -> TT (PP t a) -> String -> [Tree PE] -> TT (PP t a)
forall a. POpts -> TT a -> String -> [Tree PE] -> TT a
mkNodeCopy POpts
opts TT (PP t a)
dd String
msg1 [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]
          Just PP t a
n -> TT (PP t a) -> m (TT (PP t a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP t a) -> m (TT (PP t a))) -> TT (PP t a) -> m (TT (PP t a))
forall a b. (a -> b) -> a -> b
$ POpts -> Val (PP t a) -> String -> [Tree PE] -> TT (PP t a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP t a -> Val (PP t a)
forall a. a -> Val a
Val PP t a
n) (POpts -> String -> PP t a -> a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP t a
n a
a) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]

-- | bounded 'toEnum' function

--

-- >>> pz @(ToEnumBDef Ordering LT) 2

-- Val GT

--

-- >>> pz @(ToEnumBDef Ordering LT) 6

-- Val LT

--

-- >>> pl @(ToEnumBDef Ordering 'LT) 123

-- Present LT (ToEnumBDef out of range)

-- Val LT

--

-- >>> pl @(ToEnumBDef Ordering 'GT) 1

-- Present EQ (ToEnumBDef EQ | 1)

-- Val EQ

--

data ToEnumBDef (t :: Type) def deriving Int -> ToEnumBDef t def -> ShowS
[ToEnumBDef t def] -> ShowS
ToEnumBDef t def -> String
(Int -> ToEnumBDef t def -> ShowS)
-> (ToEnumBDef t def -> String)
-> ([ToEnumBDef t def] -> ShowS)
-> Show (ToEnumBDef t def)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall t k (def :: k). Int -> ToEnumBDef t def -> ShowS
forall t k (def :: k). [ToEnumBDef t def] -> ShowS
forall t k (def :: k). ToEnumBDef t def -> String
showList :: [ToEnumBDef t def] -> ShowS
$cshowList :: forall t k (def :: k). [ToEnumBDef t def] -> ShowS
show :: ToEnumBDef t def -> String
$cshow :: forall t k (def :: k). ToEnumBDef t def -> String
showsPrec :: Int -> ToEnumBDef t def -> ShowS
$cshowsPrec :: forall t k (def :: k). Int -> ToEnumBDef t def -> ShowS
Show
type ToEnumBDefT (t :: Type) def = ToEnumBDef' (Hole t) def Id

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

-- | bounded 'toEnum' function

--

-- >>> pz @(ToEnumBFail Ordering) 6

-- Fail "ToEnum bounded"

--

-- >>> pl @(ToEnumBFail Ordering) 1

-- Present EQ (ToEnumBDef EQ | 1)

-- Val EQ

--

-- >>> pl @(ToEnumBFail Ordering) 44

-- Error ToEnum bounded (ToEnumBDef out of range)

-- Fail "ToEnum bounded"

--

data ToEnumBFail (t :: Type) deriving Int -> ToEnumBFail t -> ShowS
[ToEnumBFail t] -> ShowS
ToEnumBFail t -> String
(Int -> ToEnumBFail t -> ShowS)
-> (ToEnumBFail t -> String)
-> ([ToEnumBFail t] -> ShowS)
-> Show (ToEnumBFail t)
forall t. Int -> ToEnumBFail t -> ShowS
forall t. [ToEnumBFail t] -> ShowS
forall t. ToEnumBFail t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ToEnumBFail t] -> ShowS
$cshowList :: forall t. [ToEnumBFail t] -> ShowS
show :: ToEnumBFail t -> String
$cshow :: forall t. ToEnumBFail t -> String
showsPrec :: Int -> ToEnumBFail t -> ShowS
$cshowsPrec :: forall t. Int -> ToEnumBFail t -> ShowS
Show
type ToEnumBFailT (t :: Type) = ToEnumBDef' (Hole t) (FailP "ToEnum bounded") Id

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

-- | similar to 'enumFromTo'

--

-- >>> pz @(EnumFromTo 'GT 'LT) ()

-- Val []

--

-- >>> pz @(EnumFromTo Pred Succ) (SG.Max 10)

-- Val [Max {getMax = 9},Max {getMax = 10},Max {getMax = 11}]

--

-- >>> pz @(EnumFromTo 1 20 >> Map '(Id, (If (Id `Mod` 3 == 0) "Fizz" "" <> If (Id `Mod` 5 == 0) "Buzz" ""))) 123

-- Val [(1,""),(2,""),(3,"Fizz"),(4,""),(5,"Buzz"),(6,"Fizz"),(7,""),(8,""),(9,"Fizz"),(10,"Buzz"),(11,""),(12,"Fizz"),(13,""),(14,""),(15,"FizzBuzz"),(16,""),(17,""),(18,"Fizz"),(19,""),(20,"Buzz")]

--

-- >>> pl @(EnumFromTo (Pure SG.Min 9) (Pure _ 13)) ()

-- Present [Min {getMin = 9},Min {getMin = 10},Min {getMin = 11},Min {getMin = 12},Min {getMin = 13}] (Min {getMin = 9} ... Min {getMin = 13})

-- Val [Min {getMin = 9},Min {getMin = 10},Min {getMin = 11},Min {getMin = 12},Min {getMin = 13}]

--

-- >>> pl @(EnumFromTo (Wrap (SG.Min _) 9) (Wrap _ 13)) ()

-- Present [Min {getMin = 9},Min {getMin = 10},Min {getMin = 11},Min {getMin = 12},Min {getMin = 13}] (Min {getMin = 9} ... Min {getMin = 13})

-- Val [Min {getMin = 9},Min {getMin = 10},Min {getMin = 11},Min {getMin = 12},Min {getMin = 13}]

--

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

-- | similar to 'enumFromTo'

--

-- >>> pz @(2 ... 5) ()

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

--

-- >>> pz @('LT ... 'GT) ()

-- Val [LT,EQ,GT]

--

-- >>> pz @('Just (MkDay '(2020, 1, 2)) ... 'Just (MkDay '(2020, 1, 7))) ()

-- Val [2020-01-02,2020-01-03,2020-01-04,2020-01-05,2020-01-06,2020-01-07]

--

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

type EnumFromToT p q = EnumFromTo p q

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

instance ( P p x
         , P q x
         , PP p x ~ a
         , Show a
         , PP q x ~ a
         , Enum a
         ) => P (EnumFromTo p q) x where
  type PP (EnumFromTo p q) x = [PP p x]
  eval :: proxy (EnumFromTo p q)
-> POpts -> x -> m (TT (PP (EnumFromTo p q) x))
eval proxy (EnumFromTo p q)
_ POpts
opts x
z = do
    let msg0 :: String
msg0 = String
"..."
    Either (TT [a]) (a, a, TT a, TT a)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT [a]) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
z []
    TT [a] -> m (TT [a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [a] -> m (TT [a])) -> TT [a] -> m (TT [a])
forall a b. (a -> b) -> a -> b
$ case Either (TT [a]) (a, a, TT a, TT a)
lr of
      Left TT [a]
e -> TT [a]
e
      Right (a
p,a
q,TT a
pp,TT a
qq) -> 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 -> [a]
forall a. Enum a => a -> a -> [a]
enumFromTo a
p a
q)) (POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
q) [TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
pp, TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
qq]

-- | similar to 'enumFromThenTo'

--

-- >>> pz @(EnumFromThenTo (10 >> ToEnum Day) (20 >> ToEnum Day) (70 >> ToEnum Day)) ()

-- Val [1858-11-27,1858-12-07,1858-12-17,1858-12-27,1859-01-06,1859-01-16,1859-01-26]

--

-- >>> pz @(EnumFromThenTo (ReadP Day "2020-01-12") (ReadP Day "2020-02-12") (ReadP Day "2020-08-12")) ()

-- Val [2020-01-12,2020-02-12,2020-03-14,2020-04-14,2020-05-15,2020-06-15,2020-07-16]

--

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

instance ( P p x
         , P q x
         , P r x
         , PP p x ~ a
         , Show a
         , PP q x ~ a
         , PP r x ~ a
         , Enum a
         ) => P (EnumFromThenTo p q r) x where
  type PP (EnumFromThenTo p q r) x = [PP p x]
  eval :: proxy (EnumFromThenTo p q r)
-> POpts -> x -> m (TT (PP (EnumFromThenTo p q r) x))
eval proxy (EnumFromThenTo p q r)
_ POpts
opts x
z = do
    let msg0 :: String
msg0 = String
"EnumFromThenTo"
    Either (TT [a]) (a, a, TT a, TT a)
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT [a]) (PP p x, PP q x, TT (PP p x), TT (PP q x)))
forall k1 k2 (p :: k1) a (q :: k2) (m :: Type -> Type)
       (proxy1 :: k1 -> Type) (proxy2 :: k2 -> Type) x.
(P p a, P q a, MonadEval m) =>
Inline
-> String
-> proxy1 p
-> proxy2 q
-> POpts
-> a
-> [Tree PE]
-> m (Either (TT x) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
runPQ Inline
NoInline String
msg0 (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts x
z []
    case Either (TT [a]) (a, a, TT a, TT a)
lr of
      Left TT [a]
e -> TT [a] -> m (TT [a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TT [a]
e
      Right (a
p,a
q,TT a
pp,TT a
qq) -> do
        TT a
rr <- Proxy r -> POpts -> x -> m (TT (PP r x))
forall k (p :: k) a (m :: Type -> Type) (proxy :: k -> Type).
(P p a, MonadEval m) =>
proxy p -> POpts -> a -> m (TT (PP p a))
eval (Proxy r
forall k (t :: k). Proxy t
Proxy @r) POpts
opts x
z
        TT [a] -> m (TT [a])
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT [a] -> m (TT [a])) -> TT [a] -> m (TT [a])
forall a b. (a -> b) -> a -> b
$ case Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT [a]) a
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts (String
msg0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" r failed") TT a
rr [TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
pp, TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
qq] of
          Left TT [a]
e -> TT [a]
e
          Right a
r ->
            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 -> a -> [a]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo a
p a
q a
r)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" [" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" .. " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
r String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]") [TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
pp, TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
qq, TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
rr]

-- | universe of enum using the type pointed to by @p@

--

-- >>> pl @(Universe' Id) LT

-- Present [LT,EQ,GT] (Universe [LT .. GT])

-- Val [LT,EQ,GT]

--

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

instance ( PP p x ~ a
         , Show a
         , Enum a
         , Bounded a
         ) => P (Universe' p) x where
  type PP (Universe' p) x = [PP p x]
  eval :: proxy (Universe' p) -> POpts -> x -> m (TT (PP (Universe' p) x))
eval proxy (Universe' p)
_ POpts
opts x
_ =
    let msg0 :: String
msg0 = String
"Universe"
        u :: [a]
u = [a
mn .. a
mx]
        mn :: a
mn = Bounded a => a
forall a. Bounded a => a
minBound @a
        mx :: a
mx = Bounded a => a
forall a. Bounded a => a
maxBound @a
    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]
u) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" [" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
mn String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" .. " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts a
mx String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]") []

-- | get universe of an enum of type @t@

--

-- >>> pz @(Universe Ordering) ()

-- Val [LT,EQ,GT]

--

data Universe (t :: Type) deriving Int -> Universe t -> ShowS
[Universe t] -> ShowS
Universe t -> String
(Int -> Universe t -> ShowS)
-> (Universe t -> String)
-> ([Universe t] -> ShowS)
-> Show (Universe t)
forall t. Int -> Universe t -> ShowS
forall t. [Universe t] -> ShowS
forall t. Universe t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Universe t] -> ShowS
$cshowList :: forall t. [Universe t] -> ShowS
show :: Universe t -> String
$cshow :: forall t. Universe t -> String
showsPrec :: Int -> Universe t -> ShowS
$cshowsPrec :: forall t. Int -> Universe t -> ShowS
Show
type UniverseT (t :: Type) = Universe' (Hole t)

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