{-# OPTIONS -Wno-redundant-constraints #-}
{-# LANGUAGE BangPatterns #-}
{-# 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 StandaloneDeriving #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE NoStarIsType #-}
module Predicate.Refined3 (
Refined3
, r3In
, r3Out
, Refined3C
, Msg3 (..)
, RResults3 (..)
, eval3P
, eval3M
, newRefined3
, newRefined3'
, newRefined3P
, newRefined3P'
, mkProxy3
, mkProxy3'
, MakeR3
, MakeR3'
, unsafeRefined3
, unsafeRefined3'
, genRefined3
, genRefined3P
) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Data.Functor.Identity (Identity(..))
import Data.Tree (Tree(..))
import Data.Proxy (Proxy(..))
import Data.Aeson (ToJSON(..), FromJSON(..))
import qualified Language.Haskell.TH.Syntax as TH
import Test.QuickCheck
import qualified GHC.Read as GR
import qualified Text.ParserCombinators.ReadPrec as PCR
import qualified Text.Read.Lex as RL
import qualified Data.Binary as B
import Data.Binary (Binary)
import Control.Lens ((^.))
import Data.Tree.Lens (root)
import Data.Char (isSpace)
import Data.String (IsString(..))
import Data.Hashable (Hashable(..))
import GHC.Stack (HasCallStack)
import Control.DeepSeq (rnf, rnf2, NFData)
data Refined3 (opts :: Opt) ip op fmt i = Refined3 !(PP ip i) !i
type role Refined3 phantom nominal nominal nominal nominal
r3In :: Refined3 opts ip op fmt i -> PP ip i
r3In :: Refined3 opts ip op fmt i -> PP ip i
r3In (Refined3 PP ip i
ppi i
_) = PP ip i
ppi
r3Out :: Refined3 opts ip op fmt i -> i
r3Out :: Refined3 opts ip op fmt i -> i
r3Out (Refined3 PP ip i
_ i
i) = i
i
unsafeRefined3' :: forall opts ip op fmt i
. ( HasCallStack
, Show (PP ip i)
, Refined3C opts ip op fmt i
) => i
-> Refined3 opts ip op fmt i
unsafeRefined3' :: i -> Refined3 opts ip op fmt i
unsafeRefined3' = (Msg3 -> Refined3 opts ip op fmt i)
-> (Refined3 opts ip op fmt i -> Refined3 opts ip op fmt i)
-> Either Msg3 (Refined3 opts ip op fmt i)
-> Refined3 opts ip op fmt i
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Refined3 opts ip op fmt i
forall a. HasCallStack => [Char] -> a
error ([Char] -> Refined3 opts ip op fmt i)
-> (Msg3 -> [Char]) -> Msg3 -> Refined3 opts ip op fmt i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Msg3 -> [Char]
forall a. Show a => a -> [Char]
show) Refined3 opts ip op fmt i -> Refined3 opts ip op fmt i
forall a. a -> a
id (Either Msg3 (Refined3 opts ip op fmt i)
-> Refined3 opts ip op fmt i)
-> (i -> Either Msg3 (Refined3 opts ip op fmt i))
-> i
-> Refined3 opts ip op fmt i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Either Msg3 (Refined3 opts ip op fmt i)
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i.
(Refined3C opts ip op fmt i, Show (PP ip i)) =>
i -> Either Msg3 (Refined3 opts ip op fmt i)
newRefined3
unsafeRefined3 ::
forall opts ip op fmt i
. Refined3C opts ip op fmt i
=> PP ip i
-> i
-> Refined3 opts ip op fmt i
unsafeRefined3 :: PP ip i -> i -> Refined3 opts ip op fmt i
unsafeRefined3 = PP ip i -> i -> Refined3 opts ip op fmt i
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i.
PP ip i -> i -> Refined3 opts ip op fmt i
Refined3
type Refined3C opts ip op fmt i =
( OptC opts
, P ip i
, P op (PP ip i)
, PP op (PP ip i) ~ Bool
, P fmt (PP ip i)
, PP fmt (PP ip i) ~ i
)
deriving instance ( Refined3C opts ip op fmt i
, Show (PP ip i)
, Show i
) => Show (Refined3 opts ip op fmt i)
deriving instance ( Refined3C opts ip op fmt i
, Eq (PP ip i)
, Eq i
) => Eq (Refined3 opts ip op fmt i)
deriving instance ( Refined3C opts ip op fmt i
, Ord (PP ip i)
, Ord i
) => Ord (Refined3 opts ip op fmt i)
deriving instance ( Refined3C opts ip op fmt i
, TH.Lift (PP ip i)
, TH.Lift i
) => TH.Lift (Refined3 opts ip op fmt i)
instance ( Refined3C opts ip op fmt i
, NFData i
, NFData (PP ip i)
) => NFData (Refined3 opts ip op fmt i) where
rnf :: Refined3 opts ip op fmt i -> ()
rnf (Refined3 PP ip i
a i
b) = (PP ip i, i) -> ()
forall (p :: Type -> Type -> Type) a b.
(NFData2 p, NFData a, NFData b) =>
p a b -> ()
rnf2 (PP ip i
a,i
b)
instance ( Refined3C opts ip op fmt String
, Show (PP ip String)
) => IsString (Refined3 opts ip op fmt String) where
fromString :: [Char] -> Refined3 opts ip op fmt [Char]
fromString [Char]
s =
case [Char] -> Either Msg3 (Refined3 opts ip op fmt [Char])
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i.
(Refined3C opts ip op fmt i, Show (PP ip i)) =>
i -> Either Msg3 (Refined3 opts ip op fmt i)
newRefined3 [Char]
s of
Left Msg3
e -> [Char] -> Refined3 opts ip op fmt [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> Refined3 opts ip op fmt [Char])
-> [Char] -> Refined3 opts ip op fmt [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Refined3(fromString):" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Msg3 -> [Char]
forall a. Show a => a -> [Char]
show Msg3
e
Right Refined3 opts ip op fmt [Char]
r -> Refined3 opts ip op fmt [Char]
r
instance ( Eq i
, Refined3C opts ip op fmt i
, Read (PP ip i)
, Read i
) => Read (Refined3 opts ip op fmt i) where
readPrec :: ReadPrec (Refined3 opts ip op fmt i)
readPrec
= ReadPrec (Refined3 opts ip op fmt i)
-> ReadPrec (Refined3 opts ip op fmt i)
forall a. ReadPrec a -> ReadPrec a
GR.parens
(Int
-> ReadPrec (Refined3 opts ip op fmt i)
-> ReadPrec (Refined3 opts ip op fmt i)
forall a. Int -> ReadPrec a -> ReadPrec a
PCR.prec
Int
10
(do Lexeme -> ReadPrec ()
GR.expectP ([Char] -> Lexeme
RL.Ident [Char]
"Refined3")
PP ip i
fld1 <- ReadPrec (PP ip i) -> ReadPrec (PP ip i)
forall a. ReadPrec a -> ReadPrec a
PCR.step ReadPrec (PP ip i)
forall a. Read a => ReadPrec a
GR.readPrec
i
fld2 <- ReadPrec i -> ReadPrec i
forall a. ReadPrec a -> ReadPrec a
PCR.step ReadPrec i
forall a. Read a => ReadPrec a
GR.readPrec
let (RResults3 (PP ip i)
_ret,Maybe (Refined3 opts ip op fmt i)
mr) = Identity (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall a. Identity a -> a
runIdentity (Identity (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i)))
-> Identity
(RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall a b. (a -> b) -> a -> b
$ PP ip i
-> Identity
(RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i
(m :: Type -> Type).
(MonadEval m, Refined3C opts ip op fmt i) =>
PP ip i
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
eval3MSkip @opts @ip @op @fmt PP ip i
fld1
case Maybe (Refined3 opts ip op fmt i)
mr of
Maybe (Refined3 opts ip op fmt i)
Nothing -> [Char] -> ReadPrec (Refined3 opts ip op fmt i)
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
""
Just (Refined3 PP ip i
_r1 i
r2)
| i
r2 i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
fld2 -> Refined3 opts ip op fmt i -> ReadPrec (Refined3 opts ip op fmt i)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (PP ip i -> i -> Refined3 opts ip op fmt i
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i.
PP ip i -> i -> Refined3 opts ip op fmt i
Refined3 PP ip i
fld1 i
fld2)
| Bool
otherwise -> [Char] -> ReadPrec (Refined3 opts ip op fmt i)
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail [Char]
""
)
)
readList :: ReadS [Refined3 opts ip op fmt i]
readList = ReadS [Refined3 opts ip op fmt i]
forall a. Read a => ReadS [a]
GR.readListDefault
readListPrec :: ReadPrec [Refined3 opts ip op fmt i]
readListPrec = ReadPrec [Refined3 opts ip op fmt i]
forall a. Read a => ReadPrec [a]
GR.readListPrecDefault
instance ( Refined3C opts ip op fmt i
, ToJSON i
) => ToJSON (Refined3 opts ip op fmt i) where
toJSON :: Refined3 opts ip op fmt i -> Value
toJSON = i -> Value
forall a. ToJSON a => a -> Value
toJSON (i -> Value)
-> (Refined3 opts ip op fmt i -> i)
-> Refined3 opts ip op fmt i
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Refined3 opts ip op fmt i -> i
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i.
Refined3 opts ip op fmt i -> i
r3Out
instance ( Refined3C opts ip op fmt i
, Show (PP ip i)
, FromJSON i
) => FromJSON (Refined3 opts ip op fmt i) where
parseJSON :: Value -> Parser (Refined3 opts ip op fmt i)
parseJSON Value
z = do
i
i <- Value -> Parser i
forall a. FromJSON a => Value -> Parser a
parseJSON @i Value
z
case i -> Either Msg3 (Refined3 opts ip op fmt i)
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i.
(Refined3C opts ip op fmt i, Show (PP ip i)) =>
i -> Either Msg3 (Refined3 opts ip op fmt i)
newRefined3 i
i of
Left Msg3
e -> [Char] -> Parser (Refined3 opts ip op fmt i)
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser (Refined3 opts ip op fmt i))
-> [Char] -> Parser (Refined3 opts ip op fmt i)
forall a b. (a -> b) -> a -> b
$ [Char]
"Refined3:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Msg3 -> [Char]
forall a. Show a => a -> [Char]
show Msg3
e
Right Refined3 opts ip op fmt i
r -> Refined3 opts ip op fmt i -> Parser (Refined3 opts ip op fmt i)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Refined3 opts ip op fmt i
r
instance ( Arbitrary (PP ip i)
, Refined3C opts ip op fmt i
) => Arbitrary (Refined3 opts ip op fmt i) where
arbitrary :: Gen (Refined3 opts ip op fmt i)
arbitrary = Gen (PP ip i) -> Gen (Refined3 opts ip op fmt i)
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i.
(Refined3C opts ip op fmt i, HasCallStack) =>
Gen (PP ip i) -> Gen (Refined3 opts ip op fmt i)
genRefined3 Gen (PP ip i)
forall a. Arbitrary a => Gen a
arbitrary
genRefined3 ::
forall opts ip op fmt i
. ( Refined3C opts ip op fmt i
, HasCallStack
)
=> Gen (PP ip i)
-> Gen (Refined3 opts ip op fmt i)
genRefined3 :: Gen (PP ip i) -> Gen (Refined3 opts ip op fmt i)
genRefined3 = Proxy '(opts, ip, op, fmt, i)
-> Gen (PP ip i) -> Gen (Refined3 opts ip op fmt i)
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i.
(Refined3C opts ip op fmt i, HasCallStack) =>
Proxy '(opts, ip, op, fmt, i)
-> Gen (PP ip i) -> Gen (Refined3 opts ip op fmt i)
genRefined3P Proxy '(opts, ip, op, fmt, i)
forall k (t :: k). Proxy t
Proxy
genRefined3P ::
forall opts ip op fmt i
. ( Refined3C opts ip op fmt i
, HasCallStack
)
=> Proxy '(opts,ip,op,fmt,i)
-> Gen (PP ip i)
-> Gen (Refined3 opts ip op fmt i)
genRefined3P :: Proxy '(opts, ip, op, fmt, i)
-> Gen (PP ip i) -> Gen (Refined3 opts ip op fmt i)
genRefined3P Proxy '(opts, ip, op, fmt, i)
_ Gen (PP ip i)
g =
let f :: Int -> Gen (Refined3 opts ip op fmt i)
f !Int
cnt = do
Maybe (PP ip i)
mppi <- Gen (PP ip i) -> (PP ip i -> Bool) -> Gen (Maybe (PP ip i))
forall a. Gen a -> (a -> Bool) -> Gen (Maybe a)
suchThatMaybe Gen (PP ip i)
g ((PP ip i -> Bool) -> Gen (Maybe (PP ip i)))
-> (PP ip i -> Bool) -> Gen (Maybe (PP ip i))
forall a b. (a -> b) -> a -> b
$ \PP ip i
a -> PP ip i -> Either [Char] (PP op (PP ip i))
forall k (opts :: Opt) (p :: k) i.
(OptC opts, P p i) =>
i -> Either [Char] (PP p i)
evalQuick @opts @op PP ip i
a Either [Char] Bool -> Either [Char] Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Either [Char] Bool
forall a b. b -> Either a b
Right Bool
True
case Maybe (PP ip i)
mppi of
Maybe (PP ip i)
Nothing ->
let o :: POpts
o = OptC opts => POpts
forall (o :: Opt). OptC o => POpts
getOpt @opts
in if Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= POpts -> HKD Identity Int
forall (f :: Type -> Type). HOpts f -> HKD f Int
oRecursion POpts
o
then [Char] -> Gen (Refined3 opts ip op fmt i)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Gen (Refined3 opts ip op fmt i))
-> [Char] -> Gen (Refined3 opts ip op fmt i)
forall a b. (a -> b) -> a -> b
$ POpts -> ShowS
setOtherEffects POpts
o ([Char]
"genRefined3P recursion exceeded(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (POpts -> HKD Identity Int
forall (f :: Type -> Type). HOpts f -> HKD f Int
oRecursion POpts
o) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")")
else Int -> Gen (Refined3 opts ip op fmt i)
f (Int
cntInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
Just PP ip i
ppi ->
case PP ip i -> Either [Char] (PP fmt (PP ip i))
forall k (opts :: Opt) (p :: k) i.
(OptC opts, P p i) =>
i -> Either [Char] (PP p i)
evalQuick @opts @fmt PP ip i
ppi of
Left [Char]
e -> [Char] -> Gen (Refined3 opts ip op fmt i)
forall a. HasCallStack => [Char] -> a
error ([Char] -> Gen (Refined3 opts ip op fmt i))
-> [Char] -> Gen (Refined3 opts ip op fmt i)
forall a b. (a -> b) -> a -> b
$ [Char]
"genRefined3P: formatting failed!! " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
e
Right PP fmt (PP ip i)
r -> Refined3 opts ip op fmt i -> Gen (Refined3 opts ip op fmt i)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Refined3 opts ip op fmt i -> Gen (Refined3 opts ip op fmt i))
-> Refined3 opts ip op fmt i -> Gen (Refined3 opts ip op fmt i)
forall a b. (a -> b) -> a -> b
$ PP ip i -> i -> Refined3 opts ip op fmt i
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i.
Refined3C opts ip op fmt i =>
PP ip i -> i -> Refined3 opts ip op fmt i
unsafeRefined3 PP ip i
ppi i
PP fmt (PP ip i)
r
in Int -> Gen (Refined3 opts ip op fmt i)
f Int
0
instance ( Refined3C opts ip op fmt i
, Show (PP ip i)
, Binary i
) => Binary (Refined3 opts ip op fmt i) where
get :: Get (Refined3 opts ip op fmt i)
get = do
i
i <- Binary i => Get i
forall t. Binary t => Get t
B.get @i
case i -> Either Msg3 (Refined3 opts ip op fmt i)
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i.
(Refined3C opts ip op fmt i, Show (PP ip i)) =>
i -> Either Msg3 (Refined3 opts ip op fmt i)
newRefined3 i
i of
Left Msg3
e -> [Char] -> Get (Refined3 opts ip op fmt i)
forall (m :: Type -> Type) a. MonadFail m => [Char] -> m a
fail ([Char] -> Get (Refined3 opts ip op fmt i))
-> [Char] -> Get (Refined3 opts ip op fmt i)
forall a b. (a -> b) -> a -> b
$ [Char]
"Refined3:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Msg3 -> [Char]
forall a. Show a => a -> [Char]
show Msg3
e
Right Refined3 opts ip op fmt i
r -> Refined3 opts ip op fmt i -> Get (Refined3 opts ip op fmt i)
forall (m :: Type -> Type) a. Monad m => a -> m a
return Refined3 opts ip op fmt i
r
put :: Refined3 opts ip op fmt i -> Put
put (Refined3 PP ip i
_ i
r) = i -> Put
forall t. Binary t => t -> Put
B.put @i i
r
instance ( Refined3C opts ip op fmt i
, Hashable (PP ip i)
) => Hashable (Refined3 opts ip op fmt i) where
hashWithSalt :: Int -> Refined3 opts ip op fmt i -> Int
hashWithSalt Int
s (Refined3 PP ip i
a i
_) = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ PP ip i -> Int
forall a. Hashable a => a -> Int
hash PP ip i
a
mkProxy3 ::
forall z opts ip op fmt i
. z ~ '(opts,ip,op,fmt,i)
=> Proxy '(opts,ip,op,fmt,i)
mkProxy3 :: Proxy '(opts, ip, op, fmt, i)
mkProxy3 = Proxy '(opts, ip, op, fmt, i)
forall k (t :: k). Proxy t
Proxy
mkProxy3' :: forall z opts ip op fmt i
. ( z ~ '(opts,ip,op,fmt,i)
, Refined3C opts ip op fmt i
) => Proxy '(opts,ip,op,fmt,i)
mkProxy3' :: Proxy '(opts, ip, op, fmt, i)
mkProxy3' = Proxy '(opts, ip, op, fmt, i)
forall k (t :: k). Proxy t
Proxy
type family MakeR3 p where
MakeR3 '(opts,ip,op,fmt,i) = Refined3 opts ip op fmt i
type family MakeR3' opts p where
MakeR3' opts '(ip,op,fmt,i) = Refined3 opts ip op fmt i
data RResults3 a =
RF !String !(Tree PE)
| RTF !a !(Tree PE) !String !(Tree PE)
| RTFalse !a !(Tree PE) !(Tree PE)
| RTTrueF !a !(Tree PE) !(Tree PE) !String !(Tree PE)
| RTTrueT !a !(Tree PE) !(Tree PE) !(Tree PE)
deriving Int -> RResults3 a -> ShowS
[RResults3 a] -> ShowS
RResults3 a -> [Char]
(Int -> RResults3 a -> ShowS)
-> (RResults3 a -> [Char])
-> ([RResults3 a] -> ShowS)
-> Show (RResults3 a)
forall a. Show a => Int -> RResults3 a -> ShowS
forall a. Show a => [RResults3 a] -> ShowS
forall a. Show a => RResults3 a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RResults3 a] -> ShowS
$cshowList :: forall a. Show a => [RResults3 a] -> ShowS
show :: RResults3 a -> [Char]
$cshow :: forall a. Show a => RResults3 a -> [Char]
showsPrec :: Int -> RResults3 a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RResults3 a -> ShowS
Show
newRefined3' :: forall opts ip op fmt i m
. ( MonadEval m
, Refined3C opts ip op fmt i
, Show (PP ip i)
)
=> i
-> m (Either Msg3 (Refined3 opts ip op fmt i))
newRefined3' :: i -> m (Either Msg3 (Refined3 opts ip op fmt i))
newRefined3' = Proxy '(opts, ip, op, fmt, i)
-> i -> m (Either Msg3 (Refined3 opts ip op fmt i))
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i
(proxy :: (Opt, k, k, k, Type) -> Type) (m :: Type -> Type).
(MonadEval m, Refined3C opts ip op fmt i, Show (PP ip i)) =>
proxy '(opts, ip, op, fmt, i)
-> i -> m (Either Msg3 (Refined3 opts ip op fmt i))
newRefined3P' Proxy '(opts, ip, op, fmt, i)
forall k (t :: k). Proxy t
Proxy
newRefined3P' :: forall opts ip op fmt i proxy m
. ( MonadEval m
, Refined3C opts ip op fmt i
, Show (PP ip i)
)
=> proxy '(opts,ip,op,fmt,i)
-> i
-> m (Either Msg3 (Refined3 opts ip op fmt i))
newRefined3P' :: proxy '(opts, ip, op, fmt, i)
-> i -> m (Either Msg3 (Refined3 opts ip op fmt i))
newRefined3P' proxy '(opts, ip, op, fmt, i)
_ i
i = do
(RResults3 (PP ip i)
ret,Maybe (Refined3 opts ip op fmt i)
mr) <- i -> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i
(m :: Type -> Type).
(MonadEval m, Refined3C opts ip op fmt i) =>
i -> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
eval3M i
i
Either Msg3 (Refined3 opts ip op fmt i)
-> m (Either Msg3 (Refined3 opts ip op fmt i))
forall (m :: Type -> Type) a. Monad m => a -> m a
return (Either Msg3 (Refined3 opts ip op fmt i)
-> m (Either Msg3 (Refined3 opts ip op fmt i)))
-> Either Msg3 (Refined3 opts ip op fmt i)
-> m (Either Msg3 (Refined3 opts ip op fmt i))
forall a b. (a -> b) -> a -> b
$ Either Msg3 (Refined3 opts ip op fmt i)
-> (Refined3 opts ip op fmt i
-> Either Msg3 (Refined3 opts ip op fmt i))
-> Maybe (Refined3 opts ip op fmt i)
-> Either Msg3 (Refined3 opts ip op fmt i)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Msg3 -> Either Msg3 (Refined3 opts ip op fmt i)
forall a b. a -> Either a b
Left (Msg3 -> Either Msg3 (Refined3 opts ip op fmt i))
-> Msg3 -> Either Msg3 (Refined3 opts ip op fmt i)
forall a b. (a -> b) -> a -> b
$ POpts -> RResults3 (PP ip i) -> Msg3
forall a. Show a => POpts -> RResults3 a -> Msg3
prt3Impl (OptC opts => POpts
forall (o :: Opt). OptC o => POpts
getOpt @opts) RResults3 (PP ip i)
ret) Refined3 opts ip op fmt i
-> Either Msg3 (Refined3 opts ip op fmt i)
forall a b. b -> Either a b
Right Maybe (Refined3 opts ip op fmt i)
mr
newRefined3 :: forall opts ip op fmt i
. ( Refined3C opts ip op fmt i
, Show (PP ip i)
)
=> i
-> Either Msg3 (Refined3 opts ip op fmt i)
newRefined3 :: i -> Either Msg3 (Refined3 opts ip op fmt i)
newRefined3 = Identity (Either Msg3 (Refined3 opts ip op fmt i))
-> Either Msg3 (Refined3 opts ip op fmt i)
forall a. Identity a -> a
runIdentity (Identity (Either Msg3 (Refined3 opts ip op fmt i))
-> Either Msg3 (Refined3 opts ip op fmt i))
-> (i -> Identity (Either Msg3 (Refined3 opts ip op fmt i)))
-> i
-> Either Msg3 (Refined3 opts ip op fmt i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Identity (Either Msg3 (Refined3 opts ip op fmt i))
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i
(m :: Type -> Type).
(MonadEval m, Refined3C opts ip op fmt i, Show (PP ip i)) =>
i -> m (Either Msg3 (Refined3 opts ip op fmt i))
newRefined3'
newRefined3P :: forall opts ip op fmt i proxy
. ( Refined3C opts ip op fmt i
, Show (PP ip i)
)
=> proxy '(opts,ip,op,fmt,i)
-> i
-> Either Msg3 (Refined3 opts ip op fmt i)
newRefined3P :: proxy '(opts, ip, op, fmt, i)
-> i -> Either Msg3 (Refined3 opts ip op fmt i)
newRefined3P proxy '(opts, ip, op, fmt, i)
p = Identity (Either Msg3 (Refined3 opts ip op fmt i))
-> Either Msg3 (Refined3 opts ip op fmt i)
forall a. Identity a -> a
runIdentity (Identity (Either Msg3 (Refined3 opts ip op fmt i))
-> Either Msg3 (Refined3 opts ip op fmt i))
-> (i -> Identity (Either Msg3 (Refined3 opts ip op fmt i)))
-> i
-> Either Msg3 (Refined3 opts ip op fmt i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy '(opts, ip, op, fmt, i)
-> i -> Identity (Either Msg3 (Refined3 opts ip op fmt i))
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i
(proxy :: (Opt, k, k, k, Type) -> Type) (m :: Type -> Type).
(MonadEval m, Refined3C opts ip op fmt i, Show (PP ip i)) =>
proxy '(opts, ip, op, fmt, i)
-> i -> m (Either Msg3 (Refined3 opts ip op fmt i))
newRefined3P' proxy '(opts, ip, op, fmt, i)
p
eval3P :: forall opts ip op fmt i m proxy
. ( MonadEval m
, Refined3C opts ip op fmt i
)
=> proxy '(opts,ip,op,fmt,i)
-> i
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
eval3P :: proxy '(opts, ip, op, fmt, i)
-> i -> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
eval3P proxy '(opts, ip, op, fmt, i)
_ = i -> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i
(m :: Type -> Type).
(MonadEval m, Refined3C opts ip op fmt i) =>
i -> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
eval3M
eval3M :: forall opts ip op fmt i m
. ( MonadEval m
, Refined3C opts ip op fmt i
)
=> i
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
eval3M :: i -> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
eval3M i
i = do
let o :: POpts
o = OptC opts => POpts
forall (o :: Opt). OptC o => POpts
getOpt @opts
TT (PP ip i)
ll <- Proxy ip -> POpts -> i -> m (TT (PP ip i))
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 ip
forall k (t :: k). Proxy t
Proxy @ip) POpts
o i
i
case TT (PP ip i) -> (Either [Char] (PP ip i), Tree PE)
forall a. TT a -> (Either [Char] a, Tree PE)
getValAndPE TT (PP ip i)
ll of
(Right PP ip i
a, Tree PE
t1) -> do
TT Bool
rr <- Proxy op -> POpts -> PP ip i -> m (TT (PP op (PP ip i)))
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 op
forall k (t :: k). Proxy t
Proxy @op) POpts
o PP ip i
a
case TT Bool -> (Either [Char] Bool, Tree PE)
forall a. TT a -> (Either [Char] a, Tree PE)
getValAndPE TT Bool
rr of
(Right Bool
True,Tree PE
t2) -> do
TT i
ss <- Proxy fmt -> POpts -> PP ip i -> m (TT (PP fmt (PP ip i)))
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 fmt
forall k (t :: k). Proxy t
Proxy @fmt) POpts
o PP ip i
a
(RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i)))
-> (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall a b. (a -> b) -> a -> b
$ case TT i -> (Either [Char] i, Tree PE)
forall a. TT a -> (Either [Char] a, Tree PE)
getValAndPE TT i
ss of
(Right i
b,Tree PE
t3) -> (PP ip i -> Tree PE -> Tree PE -> Tree PE -> RResults3 (PP ip i)
forall a. a -> Tree PE -> Tree PE -> Tree PE -> RResults3 a
RTTrueT PP ip i
a Tree PE
t1 Tree PE
t2 Tree PE
t3, Refined3 opts ip op fmt i -> Maybe (Refined3 opts ip op fmt i)
forall a. a -> Maybe a
Just (PP ip i -> i -> Refined3 opts ip op fmt i
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i.
PP ip i -> i -> Refined3 opts ip op fmt i
Refined3 PP ip i
a i
b))
(Left [Char]
e,Tree PE
t3) -> (PP ip i
-> Tree PE -> Tree PE -> [Char] -> Tree PE -> RResults3 (PP ip i)
forall a.
a -> Tree PE -> Tree PE -> [Char] -> Tree PE -> RResults3 a
RTTrueF PP ip i
a Tree PE
t1 Tree PE
t2 [Char]
e Tree PE
t3, Maybe (Refined3 opts ip op fmt i)
forall a. Maybe a
Nothing)
(Right Bool
False,Tree PE
t2) -> (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (PP ip i -> Tree PE -> Tree PE -> RResults3 (PP ip i)
forall a. a -> Tree PE -> Tree PE -> RResults3 a
RTFalse PP ip i
a Tree PE
t1 Tree PE
t2, Maybe (Refined3 opts ip op fmt i)
forall a. Maybe a
Nothing)
(Left [Char]
e,Tree PE
t2) -> (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (PP ip i -> Tree PE -> [Char] -> Tree PE -> RResults3 (PP ip i)
forall a. a -> Tree PE -> [Char] -> Tree PE -> RResults3 a
RTF PP ip i
a Tree PE
t1 [Char]
e Tree PE
t2, Maybe (Refined3 opts ip op fmt i)
forall a. Maybe a
Nothing)
(Left [Char]
e,Tree PE
t1) -> (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Char] -> Tree PE -> RResults3 (PP ip i)
forall a. [Char] -> Tree PE -> RResults3 a
RF [Char]
e Tree PE
t1, Maybe (Refined3 opts ip op fmt i)
forall a. Maybe a
Nothing)
eval3MSkip :: forall opts ip op fmt i m
. ( MonadEval m
, Refined3C opts ip op fmt i
)
=> PP ip i
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
eval3MSkip :: PP ip i
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
eval3MSkip PP ip i
a = do
let o :: POpts
o = OptC opts => POpts
forall (o :: Opt). OptC o => POpts
getOpt @opts
TT Bool
rr <- Proxy op -> POpts -> PP ip i -> m (TT (PP op (PP ip i)))
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 op
forall k (t :: k). Proxy t
Proxy @op) POpts
o PP ip i
a
case TT Bool -> (Either [Char] Bool, Tree PE)
forall a. TT a -> (Either [Char] a, Tree PE)
getValAndPE TT Bool
rr of
(Right Bool
True,Tree PE
t2) -> do
TT i
ss <- Proxy fmt -> POpts -> PP ip i -> m (TT (PP fmt (PP ip i)))
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 fmt
forall k (t :: k). Proxy t
Proxy @fmt) POpts
o PP ip i
a
(RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i)))
-> (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall a b. (a -> b) -> a -> b
$ case TT i -> (Either [Char] i, Tree PE)
forall a. TT a -> (Either [Char] a, Tree PE)
getValAndPE TT i
ss of
(Right i
b,Tree PE
t3) -> (PP ip i -> Tree PE -> Tree PE -> Tree PE -> RResults3 (PP ip i)
forall a. a -> Tree PE -> Tree PE -> Tree PE -> RResults3 a
RTTrueT PP ip i
a Tree PE
mkNodeSkipP Tree PE
t2 Tree PE
t3, Refined3 opts ip op fmt i -> Maybe (Refined3 opts ip op fmt i)
forall a. a -> Maybe a
Just (PP ip i -> i -> Refined3 opts ip op fmt i
forall k k k (opts :: Opt) (ip :: k) (op :: k) (fmt :: k) i.
PP ip i -> i -> Refined3 opts ip op fmt i
Refined3 PP ip i
a i
b))
(Left [Char]
e,Tree PE
t3) -> (PP ip i
-> Tree PE -> Tree PE -> [Char] -> Tree PE -> RResults3 (PP ip i)
forall a.
a -> Tree PE -> Tree PE -> [Char] -> Tree PE -> RResults3 a
RTTrueF PP ip i
a Tree PE
mkNodeSkipP Tree PE
t2 [Char]
e Tree PE
t3, Maybe (Refined3 opts ip op fmt i)
forall a. Maybe a
Nothing)
(Right Bool
False,Tree PE
t2) -> (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (PP ip i -> Tree PE -> Tree PE -> RResults3 (PP ip i)
forall a. a -> Tree PE -> Tree PE -> RResults3 a
RTFalse PP ip i
a Tree PE
mkNodeSkipP Tree PE
t2, Maybe (Refined3 opts ip op fmt i)
forall a. Maybe a
Nothing)
(Left [Char]
e,Tree PE
t2) -> (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
-> m (RResults3 (PP ip i), Maybe (Refined3 opts ip op fmt i))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (PP ip i -> Tree PE -> [Char] -> Tree PE -> RResults3 (PP ip i)
forall a. a -> Tree PE -> [Char] -> Tree PE -> RResults3 a
RTF PP ip i
a Tree PE
mkNodeSkipP [Char]
e Tree PE
t2, Maybe (Refined3 opts ip op fmt i)
forall a. Maybe a
Nothing)
mkNodeSkipP :: Tree PE
mkNodeSkipP :: Tree PE
mkNodeSkipP = PE -> Forest PE -> Tree PE
forall a. a -> Forest a -> Tree a
Node (ValP -> [Char] -> PE
PE ValP
TrueP [Char]
"skipped PP ip i = Id") []
data Msg3 = Msg3 { Msg3 -> [Char]
m3Desc :: !String
, Msg3 -> [Char]
m3Short :: !String
, Msg3 -> [Char]
m3Long :: !String
, Msg3 -> ValP
m3ValP :: !ValP
} deriving Msg3 -> Msg3 -> Bool
(Msg3 -> Msg3 -> Bool) -> (Msg3 -> Msg3 -> Bool) -> Eq Msg3
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Msg3 -> Msg3 -> Bool
$c/= :: Msg3 -> Msg3 -> Bool
== :: Msg3 -> Msg3 -> Bool
$c== :: Msg3 -> Msg3 -> Bool
Eq
instance Show Msg3 where
show :: Msg3 -> [Char]
show (Msg3 [Char]
a [Char]
b [Char]
c ValP
_d) = [Char]
a [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char] -> ShowS
nullIf [Char]
" | " [Char]
b [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char] -> ShowS
nullIf [Char]
"\n" [Char]
c
prt3Impl :: forall a . Show a
=> POpts
-> RResults3 a
-> Msg3
prt3Impl :: POpts -> RResults3 a -> Msg3
prt3Impl POpts
opts RResults3 a
v =
let outmsg :: ShowS
outmsg [Char]
msg = [Char]
"*** " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
formatOMsg POpts
opts [Char]
" " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
msg [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" ***\n"
msg1 :: a -> [Char]
msg1 a
a = ShowS
outmsg ([Char]
"Step 1. Success Initial Conversion(ip) (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ POpts -> a -> [Char]
forall a. Show a => POpts -> a -> [Char]
showL POpts
opts a
a [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")")
mkMsg3 :: [Char] -> [Char] -> [Char] -> ValP -> Msg3
mkMsg3 [Char]
m [Char]
n [Char]
r ValP
bp | POpts -> Bool
hasNoTree POpts
opts = [Char] -> [Char] -> [Char] -> ValP -> Msg3
Msg3 [Char]
m [Char]
n [Char]
"" ValP
bp
| Bool
otherwise = [Char] -> [Char] -> [Char] -> ValP -> Msg3
Msg3 [Char]
m [Char]
n [Char]
r ValP
bp
in case RResults3 a
v of
RF [Char]
e Tree PE
t1 ->
let ([Char]
m,[Char]
n) = ([Char]
"Step 1. " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Long -> POpts -> ValP -> [Char]
colorValP Long
Short POpts
opts ([Char] -> ValP
FailP [Char]
e) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" Initial Conversion(ip)", [Char]
e)
r :: [Char]
r = ShowS
outmsg [Char]
m
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Tree PE -> [Char]
prtTreePure POpts
opts Tree PE
t1
in [Char] -> [Char] -> [Char] -> ValP -> Msg3
mkMsg3 [Char]
m [Char]
n [Char]
r (Tree PE
t1 Tree PE -> Getting ValP (Tree PE) ValP -> ValP
forall s a. s -> Getting a s a -> a
^. (PE -> Const ValP PE) -> Tree PE -> Const ValP (Tree PE)
forall a. Lens' (Tree a) a
root ((PE -> Const ValP PE) -> Tree PE -> Const ValP (Tree PE))
-> ((ValP -> Const ValP ValP) -> PE -> Const ValP PE)
-> Getting ValP (Tree PE) ValP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValP -> Const ValP ValP) -> PE -> Const ValP PE
Lens' PE ValP
peValP)
RTF a
a Tree PE
t1 [Char]
e Tree PE
t2 ->
let ([Char]
m,[Char]
n) = ([Char]
"Step 2. " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Long -> POpts -> ValP -> [Char]
colorValP Long
Short POpts
opts ([Char] -> ValP
FailP [Char]
e) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" Boolean Check(op)", [Char]
e)
r :: [Char]
r = a -> [Char]
msg1 a
a
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Tree PE -> [Char]
prtTreePure POpts
opts Tree PE
t1
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n"
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
outmsg [Char]
m
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Tree PE -> [Char]
prtTreePure POpts
opts Tree PE
t2
in [Char] -> [Char] -> [Char] -> ValP -> Msg3
mkMsg3 [Char]
m [Char]
n [Char]
r (Tree PE
t2 Tree PE -> Getting ValP (Tree PE) ValP -> ValP
forall s a. s -> Getting a s a -> a
^. (PE -> Const ValP PE) -> Tree PE -> Const ValP (Tree PE)
forall a. Lens' (Tree a) a
root ((PE -> Const ValP PE) -> Tree PE -> Const ValP (Tree PE))
-> ((ValP -> Const ValP ValP) -> PE -> Const ValP PE)
-> Getting ValP (Tree PE) ValP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValP -> Const ValP ValP) -> PE -> Const ValP PE
Lens' PE ValP
peValP)
RTFalse a
a Tree PE
t1 Tree PE
t2 ->
let ([Char]
m,[Char]
n) = ([Char]
"Step 2. " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Long -> POpts -> ValP -> [Char]
colorValP Long
Short POpts
opts ValP
FalseP [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" Boolean Check(op)", [Char]
z)
z :: [Char]
z = let w :: [Char]
w = Tree PE
t2 Tree PE -> Getting [Char] (Tree PE) [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^. (PE -> Const [Char] PE) -> Tree PE -> Const [Char] (Tree PE)
forall a. Lens' (Tree a) a
root ((PE -> Const [Char] PE) -> Tree PE -> Const [Char] (Tree PE))
-> (([Char] -> Const [Char] [Char]) -> PE -> Const [Char] PE)
-> Getting [Char] (Tree PE) [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Const [Char] [Char]) -> PE -> Const [Char] PE
Lens' PE [Char]
peString
in if (Char -> Bool) -> [Char] -> Bool
forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace [Char]
w then [Char]
"FalseP" else [Char]
"{" [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
w [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"}"
r :: [Char]
r = a -> [Char]
msg1 a
a
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Tree PE -> [Char]
prtTreePure POpts
opts Tree PE
t1
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n"
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
outmsg [Char]
m
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Tree PE -> [Char]
prtTreePure POpts
opts Tree PE
t2
in [Char] -> [Char] -> [Char] -> ValP -> Msg3
mkMsg3 [Char]
m [Char]
n [Char]
r ValP
FalseP
RTTrueF a
a Tree PE
t1 Tree PE
t2 [Char]
e Tree PE
t3 ->
let ([Char]
m,[Char]
n) = ([Char]
"Step 3. " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Long -> POpts -> ValP -> [Char]
colorValP Long
Short POpts
opts ([Char] -> ValP
FailP [Char]
e) [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" Output Conversion(fmt)", [Char]
e)
r :: [Char]
r = a -> [Char]
msg1 a
a
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Tree PE -> [Char]
prtTreePure POpts
opts Tree PE
t1
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n"
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
outmsg [Char]
"Step 2. Success Boolean Check(op)"
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Tree PE -> [Char]
prtTreePure POpts
opts Tree PE
t2
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n"
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
outmsg [Char]
m
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Tree PE -> [Char]
prtTreePure POpts
opts Tree PE
t3
in [Char] -> [Char] -> [Char] -> ValP -> Msg3
mkMsg3 [Char]
m [Char]
n [Char]
r (Tree PE
t3 Tree PE -> Getting ValP (Tree PE) ValP -> ValP
forall s a. s -> Getting a s a -> a
^. (PE -> Const ValP PE) -> Tree PE -> Const ValP (Tree PE)
forall a. Lens' (Tree a) a
root ((PE -> Const ValP PE) -> Tree PE -> Const ValP (Tree PE))
-> ((ValP -> Const ValP ValP) -> PE -> Const ValP PE)
-> Getting ValP (Tree PE) ValP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValP -> Const ValP ValP) -> PE -> Const ValP PE
Lens' PE ValP
peValP)
RTTrueT a
a Tree PE
t1 Tree PE
t2 Tree PE
t3 ->
let ([Char]
m,[Char]
n) = ([Char]
"Step 3. Success Output Conversion(fmt)", [Char]
"")
r :: [Char]
r = a -> [Char]
msg1 a
a
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Tree PE -> [Char]
prtTreePure POpts
opts Tree PE
t1
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n"
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
outmsg [Char]
"Step 2. Success Boolean Check(op)"
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Tree PE -> [Char]
prtTreePure POpts
opts Tree PE
t2
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
"\n"
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
outmsg [Char]
m
[Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> Tree PE -> [Char]
prtTreePure POpts
opts Tree PE
t3
in [Char] -> [Char] -> [Char] -> ValP -> Msg3
mkMsg3 [Char]
m [Char]
n [Char]
r (Tree PE
t3 Tree PE -> Getting ValP (Tree PE) ValP -> ValP
forall s a. s -> Getting a s a -> a
^. (PE -> Const ValP PE) -> Tree PE -> Const ValP (Tree PE)
forall a. Lens' (Tree a) a
root ((PE -> Const ValP PE) -> Tree PE -> Const ValP (Tree PE))
-> ((ValP -> Const ValP ValP) -> PE -> Const ValP PE)
-> Getting ValP (Tree PE) ValP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ValP -> Const ValP ValP) -> PE -> Const ValP PE
Lens' PE ValP
peValP)