{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# 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 #-}
{-# LANGUAGE DerivingStrategies #-}
-- | promoted numeric functions

module Predicate.Data.Numeric (

  -- ** numeric

    type (+)
  , type (-)
  , type (*)
  , type (/)
  , Negate
  , Abs
  , Signum
  , FromInteger
  , FromInteger'
  , FromIntegral
  , FromIntegral'
  , Truncate
  , Truncate'
  , Ceiling
  , Ceiling'
  , Floor
  , Floor'
  , Even
  , Odd
  , Div
  , Mod
  , DivMod
  , QuotRem
  , Quot
  , Rem
  , LogBase
  , type (^)
  , type (**)
  , DivI
  , RoundUp

  -- ** rational numbers

  , type (%)
  , type (-%)
  , ToRational
  , FromRational
  , FromRational'

 -- ** read-show

  , ReadBase
  , ReadBase'
  , ShowBase
  , ShowBaseN
  , UnShowBaseN
  , ToBits
 ) where
import Predicate.Core
import Predicate.Misc
import Predicate.Util
import Predicate.Data.Ordering (type (==))
import GHC.TypeLits (Nat,KnownNat)
import Data.Function (fix)
import Data.Typeable (Typeable, Proxy(Proxy))
import Data.Kind (Type)
import qualified Numeric.Lens (base)
import Data.Ratio ((%))
import GHC.Real (Ratio((:%)))
import Control.Lens
-- $setup

-- >>> :set -XDataKinds

-- >>> :set -XTypeApplications

-- >>> :set -XTypeOperators

-- >>> :set -XOverloadedStrings

-- >>> :set -XNoOverloadedLists

-- >>> import Predicate

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

-- >>> import Data.Time


-- | 'fromInteger' function where you need to provide a reference to the type @t@ of the result

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

instance ( Num (PP t a)
         , Integral (PP p a)
         , P p a
         , Show (PP t a)
         ) => P (FromInteger' t p) a where
  type PP (FromInteger' t p) a = PP t a
  eval :: proxy (FromInteger' t p)
-> POpts -> a -> m (TT (PP (FromInteger' t p) a))
eval proxy (FromInteger' t p)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"FromInteger"
    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
    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 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)
e
      Right PP p a
p ->
        let b :: PP t a
b = Integer -> PP t a
forall a. Num a => Integer -> a
fromInteger (PP p a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral PP p a
p)
        in 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
b) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP t a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP t a
b) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]

-- | 'fromInteger' function where you need to provide the type @t@ of the result

--

-- >>> pz @(FromInteger (SG.Sum _)) 23

-- Val (Sum {getSum = 23})

--

-- >>> pz @(44 >> FromInteger Rational) 12

-- Val (44 % 1)

--

-- >>> pz @(FromInteger Rational) 12

-- Val (12 % 1)

--

-- >>> pl @((Lift (FromInteger _) 12 &&& Id) >> Fst + Snd) (SG.Min 7)

-- Present Min {getMin = 19} ((>>) Min {getMin = 19} | {getMin = 19})

-- Val (Min {getMin = 19})

--

-- >>> pl @(Lift (FromInteger _) 12 <> Id) (SG.Product 7)

-- Present Product {getProduct = 84} (Product {getProduct = 12} <> Product {getProduct = 7} = Product {getProduct = 84})

-- Val (Product {getProduct = 84})

--

-- >>> pl @(Fst >> FromInteger (SG.Sum _)) (3,"A")

-- Present Sum {getSum = 3} ((>>) Sum {getSum = 3} | {getSum = 3})

-- Val (Sum {getSum = 3})

--

-- >>> pl @(Lift (FromInteger DiffTime) 123) 'x'

-- Present 123s ((>>) 123s | {FromInteger 123s})

-- Val 123s

--

data FromInteger (t :: Type) deriving Int -> FromInteger t -> ShowS
[FromInteger t] -> ShowS
FromInteger t -> String
(Int -> FromInteger t -> ShowS)
-> (FromInteger t -> String)
-> ([FromInteger t] -> ShowS)
-> Show (FromInteger t)
forall t. Int -> FromInteger t -> ShowS
forall t. [FromInteger t] -> ShowS
forall t. FromInteger t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FromInteger t] -> ShowS
$cshowList :: forall t. [FromInteger t] -> ShowS
show :: FromInteger t -> String
$cshow :: forall t. FromInteger t -> String
showsPrec :: Int -> FromInteger t -> ShowS
$cshowsPrec :: forall t. Int -> FromInteger t -> ShowS
Show
type FromIntegerT (t :: Type) = FromInteger' (Hole t) Id
--type FromIntegerP p = FromInteger' UnproxyT n


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

-- | 'fromIntegral' function where you need to provide a reference to the type @t@ of the result

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

instance ( Num (PP t a)
         , Integral (PP p a)
         , P p a
         , Show (PP t a)
         , Show (PP p a)
         ) => P (FromIntegral' t p) a where
  type PP (FromIntegral' t p) a = PP t a
  eval :: proxy (FromIntegral' t p)
-> POpts -> a -> m (TT (PP (FromIntegral' t p) a))
eval proxy (FromIntegral' t p)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"FromIntegral"
    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
    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 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)
e
      Right PP p a
p ->
        let b :: PP t a
b = PP p a -> PP t a
forall a b. (Integral a, Num b) => a -> b
fromIntegral PP p a
p
        in 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
b) (POpts -> String -> PP t a -> PP p a -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP t a
b PP p a
p) [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp]

-- | 'fromIntegral' function where you need to provide the type @t@ of the result

--

-- >>> pz @(FromIntegral (SG.Sum _)) 23

-- Val (Sum {getSum = 23})

--

-- >>> pz @(Pop1' (Proxy FromIntegral) 'Proxy 44) (1 % 0)

-- Val (44 % 1)

--

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

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

-- | 'toRational' function

--

-- >>> pz @(ToRational Id) 23.5

-- Val (47 % 2)

--

-- >>> pl @((ToRational 123 &&& Id) >> Fst + Snd) 4.2

-- Present 636 % 5 ((>>) 636 % 5 | {123 % 1 + 21 % 5 = 636 % 5})

-- Val (636 % 5)

--

-- >>> pl @(Fst >= Snd || Snd > 23 || 12 -% 5 <= ToRational Fst) (12,13)

-- True (False || True)

-- Val True

--

-- >>> pl @(ToRational 14) ()

-- Present 14 % 1 (ToRational 14 % 1 | 14)

-- Val (14 % 1)

--

-- >>> pl @(ToRational 5 / ToRational 3) 'x'

-- Present 5 % 3 (5 % 1 / 3 % 1 = 5 % 3)

-- Val (5 % 3)

--

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

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

-- | 'fromRational' function where you need to provide a reference to the type @t@ of the result

--

-- >>> pl @(FromRational' Fst Snd) (1,2 % 5)

-- Present 0.4 (FromRational 0.4 | 2 % 5)

-- Val 0.4

--

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

instance ( P p a
         , PP p a ~ Rational
         , Show (PP t a)
         , Fractional (PP t a)
         ) => P (FromRational' t p) a where
  type PP (FromRational' t p) a = PP t a
  eval :: proxy (FromRational' t p)
-> POpts -> a -> m (TT (PP (FromRational' t p) a))
eval proxy (FromRational' t p)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"FromRational"
    TT Rational
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
    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 Rational
-> [Tree PE]
-> Either (TT (PP t a)) Rational
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT Rational
pp [] of
      Left TT (PP t a)
e -> TT (PP t a)
e
      Right Rational
p ->
        let b :: PP t a
b = Rational -> PP t a
forall a. Fractional a => Rational -> a
fromRational @(PP t a) Rational
p
        in 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
b) (POpts -> String -> PP t a -> Rational -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP t a
b Rational
p) [TT Rational -> Tree PE
forall a. TT a -> Tree PE
hh TT Rational
pp]

-- | 'fromRational' function where you need to provide the type @t@ of the result

--

-- >>> pz @(FromRational Rational) 23.5

-- Val (47 % 2)

--

-- >>> pl @(FromRational Float) (4 % 5)

-- Present 0.8 (FromRational 0.8 | 4 % 5)

-- Val 0.8

--

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

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

-- | 'truncate' function where you need to provide a reference to the type @t@ of the result

--

-- >>> pl @(Truncate' (Fst >> UnproxyT) Snd) (Proxy @Integer,2.3)

-- Present 2 (Truncate 2 | 2.3)

-- Val 2

--

-- >>> pl @(Truncate' Fst Snd) (1::Int,2.3)

-- Present 2 (Truncate 2 | 2.3)

-- Val 2

--

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

instance ( P p x
         , RealFrac (PP p x)
         , Integral (PP t x)
         , Show (PP t x)
         , Show (PP p x)
         ) => P (Truncate' t p) x where
  type PP (Truncate' t p) x = PP t x
  eval :: proxy (Truncate' t p)
-> POpts -> x -> m (TT (PP (Truncate' t p) x))
eval proxy (Truncate' t p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"Truncate"
    TT (PP p x)
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) -> 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 Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (PP t x)) (PP p x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p x)
pp [] of
      Left TT (PP t x)
e -> TT (PP t x)
e
      Right PP p x
p ->
        let b :: PP t x
b = PP p x -> PP t x
forall a b. (RealFrac a, Integral b) => a -> b
truncate PP p x
p
        in 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
b) (POpts -> String -> PP t x -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP t x
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]

-- | 'truncate' function where you need to provide the type @t@ of the result

--

-- >>> pz @(Truncate Int) (23 % 5)

-- Val 4

--

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

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

-- | 'ceiling' function where you need to provide a reference to the type @t@ of the result

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

instance ( P p x
         , RealFrac (PP p x)
         , Integral (PP t x)
         , Show (PP t x)
         , Show (PP p x)
         ) => P (Ceiling' t p) x where
  type PP (Ceiling' t p) x = PP t x
  eval :: proxy (Ceiling' t p) -> POpts -> x -> m (TT (PP (Ceiling' t p) x))
eval proxy (Ceiling' t p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"Ceiling"
    TT (PP p x)
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) -> 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 Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (PP t x)) (PP p x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p x)
pp [] of
      Left TT (PP t x)
e -> TT (PP t x)
e
      Right PP p x
p ->
        let b :: PP t x
b = PP p x -> PP t x
forall a b. (RealFrac a, Integral b) => a -> b
ceiling PP p x
p
        in 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
b) (POpts -> String -> PP t x -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP t x
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]

-- | 'ceiling' function where you need to provide the type @t@ of the result

--

-- >>> pz @(Ceiling Int) (23 % 5)

-- Val 5

--

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

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

-- | 'floor' function where you need to provide a reference to the type @t@ of the result

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

instance ( P p x
         , RealFrac (PP p x)
         , Integral (PP t x)
         , Show (PP t x)
         , Show (PP p x)
         ) => P (Floor' t p) x where
  type PP (Floor' t p) x = PP t x
  eval :: proxy (Floor' t p) -> POpts -> x -> m (TT (PP (Floor' t p) x))
eval proxy (Floor' t p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"Floor"
    TT (PP p x)
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) -> 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 Inline
-> POpts
-> String
-> TT (PP p x)
-> [Tree PE]
-> Either (TT (PP t x)) (PP p x)
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT (PP p x)
pp [] of
      Left TT (PP t x)
e -> TT (PP t x)
e
      Right PP p x
p ->
        let b :: PP t x
b = PP p x -> PP t x
forall a b. (RealFrac a, Integral b) => a -> b
floor PP p x
p
        in 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
b) (POpts -> String -> PP t x -> PP p x -> String
forall a1 a2.
(Show a1, Show a2) =>
POpts -> String -> a1 -> a2 -> String
show3 POpts
opts String
msg0 PP t x
b PP p x
p) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]

-- | 'floor' function where you need to provide the type @t@ of the result

--

-- >>> pz @(Floor Int) (23 % 5)

-- Val 4

--

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

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

data BinOp = BMult | BSub | BAdd
  deriving stock (ReadPrec [BinOp]
ReadPrec BinOp
Int -> ReadS BinOp
ReadS [BinOp]
(Int -> ReadS BinOp)
-> ReadS [BinOp]
-> ReadPrec BinOp
-> ReadPrec [BinOp]
-> Read BinOp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BinOp]
$creadListPrec :: ReadPrec [BinOp]
readPrec :: ReadPrec BinOp
$creadPrec :: ReadPrec BinOp
readList :: ReadS [BinOp]
$creadList :: ReadS [BinOp]
readsPrec :: Int -> ReadS BinOp
$creadsPrec :: Int -> ReadS BinOp
Read, Int -> BinOp -> ShowS
[BinOp] -> ShowS
BinOp -> String
(Int -> BinOp -> ShowS)
-> (BinOp -> String) -> ([BinOp] -> ShowS) -> Show BinOp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BinOp] -> ShowS
$cshowList :: [BinOp] -> ShowS
show :: BinOp -> String
$cshow :: BinOp -> String
showsPrec :: Int -> BinOp -> ShowS
$cshowsPrec :: Int -> BinOp -> ShowS
Show, BinOp -> BinOp -> Bool
(BinOp -> BinOp -> Bool) -> (BinOp -> BinOp -> Bool) -> Eq BinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BinOp -> BinOp -> Bool
$c/= :: BinOp -> BinOp -> Bool
== :: BinOp -> BinOp -> Bool
$c== :: BinOp -> BinOp -> Bool
Eq)

-- | adds two values together pointed to by @p@ and @q@

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
infixl 6 +

type AddT p q = Bin 'BAdd p q

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

-- | subtracts two values together pointed to by @p@ and @q@

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
infixl 6 -

type SubT p q = Bin 'BSub p q

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

-- | multiply two values together pointed to by @p@ and @q@

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
infixl 7 *

type MultT p q = Bin 'BMult p q

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

-- | similar to 'GHC.Real.(^)'

--

-- >>> pz @(Fst ^ Snd) (10,4)

-- Val 10000

--

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
infixr 8 ^

instance ( P p a
         , P q a
         , Show (PP p a)
         , Show (PP q a)
         , Num (PP p a)
         , Integral (PP q a)
         ) => P (p ^ q) a where
  type PP (p ^ q) a = PP p a
  eval :: proxy (p ^ q) -> POpts -> a -> m (TT (PP (p ^ q) a))
eval proxy (p ^ q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"Pow"
    Either (TT (PP p a)) (PP p a, PP q a, TT (PP p a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP p a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
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 a
a []
    TT (PP p a) -> m (TT (PP p a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p a) -> m (TT (PP p a))) -> TT (PP p a) -> m (TT (PP p a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP p a)) (PP p a, PP q a, TT (PP p a), TT (PP q a))
lr of
      Left TT (PP p a)
e -> TT (PP p a)
e
      Right (PP p a
p,PP q a
q,TT (PP p a)
pp,TT (PP q a)
qq) ->
        let hhs :: [Tree PE]
hhs = [TT (PP p a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
        in if PP q a
q PP q a -> PP q a -> Bool
forall a. Ord a => a -> a -> Bool
< PP q a
0 then POpts -> Val (PP p a) -> String -> [Tree PE] -> TT (PP p a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP p a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" negative exponent")) String
"" [Tree PE]
hhs
           else let d :: PP p a
d = PP p a
p PP p a -> PP q a -> PP p a
forall a b. (Num a, Integral b) => a -> b -> a
^ PP q a
q
                in POpts -> Val (PP p a) -> String -> [Tree PE] -> TT (PP p a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP p a -> Val (PP p a)
forall a. a -> Val a
Val PP p a
d) (POpts -> PP p a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ^ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP p a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP p a
d) [Tree PE]
hhs

-- | similar to 'GHC.Float.(**)'

--

-- >>> pz @(Fst ** Snd) (10,4)

-- Val 10000.0

--

-- >>> pz @'(IsPrime,Id ^ 3,(FromIntegral _) ** (Lift (FromRational _) (1 % 2))) 4

-- Val (False,64,2.0)

--

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
infixr 8 **

instance ( PP p a ~ PP q a
         , P p a
         , P q a
         , Show (PP p a)
         , Floating (PP p a)
         , Ord (PP q a)
         ) => P (p ** q) a where
  type PP (p ** q) a = PP p a
  eval :: proxy (p ** q) -> POpts -> a -> m (TT (PP (p ** q) a))
eval proxy (p ** q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"Exp"
    Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
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 a
a []
    TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
      Left TT (PP q a)
e -> TT (PP q a)
e
      Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
         let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
         in if PP q a
q PP q a -> PP q a -> Bool
forall a. Ord a => a -> a -> Bool
< PP q a
0 then POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" negative exponent")) String
"" [Tree PE]
hhs
            else if PP q a
p PP q a -> PP q a -> Bool
forall a. Eq a => a -> a -> Bool
== PP q a
0 Bool -> Bool -> Bool
&& PP q a
q PP q a -> PP q a -> Bool
forall a. Eq a => a -> a -> Bool
== PP q a
0 then POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero/zero")) String
"" [Tree PE]
hhs
            else let d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
forall a. Floating a => a -> a -> a
** PP q a
q
                in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ** " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [Tree PE]
hhs

-- | similar to 'logBase'

--

-- >>> pz @(Fst `LogBase` Snd >> Truncate Int) (10,12345)

-- Val 4

--

data LogBase p q deriving Int -> LogBase p q -> ShowS
[LogBase p q] -> ShowS
LogBase p q -> String
(Int -> LogBase p q -> ShowS)
-> (LogBase p q -> String)
-> ([LogBase p q] -> ShowS)
-> Show (LogBase p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> LogBase p q -> ShowS
forall k (p :: k) k (q :: k). [LogBase p q] -> ShowS
forall k (p :: k) k (q :: k). LogBase p q -> String
showList :: [LogBase p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [LogBase p q] -> ShowS
show :: LogBase p q -> String
$cshow :: forall k (p :: k) k (q :: k). LogBase p q -> String
showsPrec :: Int -> LogBase p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> LogBase p q -> ShowS
Show
instance ( PP p a ~ PP q a
         , P p a
         , P q a
         , Show (PP q a)
         , Floating (PP q a)
         , Ord (PP p a)
         ) => P (LogBase p q) a where
  type PP (LogBase p q) a = PP p a
  eval :: proxy (LogBase p q) -> POpts -> a -> m (TT (PP (LogBase p q) a))
eval proxy (LogBase p q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"LogBase"
    Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
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 a
a []
    TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
      Left TT (PP q a)
e -> TT (PP q a)
e
      Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
         let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
         in if PP q a
p PP q a -> PP q a -> Bool
forall a. Ord a => a -> a -> Bool
<= PP q a
0 then POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" non-positive base")) String
"" [Tree PE]
hhs
            else let d :: PP q a
d = PP q a -> PP q a -> PP q a
forall a. Floating a => a -> a -> a
logBase PP q a
p PP q a
q
                 in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [Tree PE]
hhs

class GetBinOp (k :: BinOp) where
  getBinOp :: (Num a, a ~ b) => (String, a -> b -> a)

instance GetBinOp 'BMult where
  getBinOp :: (String, a -> b -> a)
getBinOp = (String
"*",a -> b -> a
forall a. Num a => a -> a -> a
(*))
instance GetBinOp 'BSub where
  getBinOp :: (String, a -> b -> a)
getBinOp = (String
"-",(-))
instance GetBinOp 'BAdd where
  getBinOp :: (String, a -> b -> a)
getBinOp = (String
"+",a -> b -> a
forall a. Num a => a -> a -> a
(+))

-- | addition, multiplication and subtraction

--

-- >>> pz @(Fst * Snd) (13,5)

-- Val 65

--

-- >>> pz @(Fst + 4 * Length Snd - 4) (3,"hello")

-- Val 19

--

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

instance ( GetBinOp op
         , PP p a ~ PP q a
         , P p a
         , P q a
         , Show (PP p a)
         , Num (PP p a)
         ) => P (Bin op p q) a where
  type PP (Bin op p q) a = PP p a
  eval :: proxy (Bin op p q) -> POpts -> a -> m (TT (PP (Bin op p q) a))
eval proxy (Bin op p q)
_ POpts
opts a
a = do
    let (String
s,PP q a -> PP q a -> PP q a
f) = forall a b. (GetBinOp op, Num a, a ~ b) => (String, a -> b -> a)
forall (k :: BinOp) a b.
(GetBinOp k, Num a, a ~ b) =>
(String, a -> b -> a)
getBinOp @op
    Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
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
s (Proxy p
forall k (t :: k). Proxy t
Proxy @p) (Proxy q
forall k (t :: k). Proxy t
Proxy @q) POpts
opts a
a []
    TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
      Left TT (PP q a)
e -> TT (PP q a)
e
      Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
        let d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
`f` PP q a
q
        in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]

-- | fractional division

--

-- >>> pz @(Fst / Snd) (13,2)

-- Val 6.5

--

-- >>> pz @(ToRational 13 / Id) 0

-- Fail "(/) zero denominator"

--

-- >>> pz @(12 % 7 / 14 % 5 + Id) 12.4

-- Val (3188 % 245)

--

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
infixl 7 /

instance ( PP p a ~ PP q a
         , Eq (PP q a)
         , P p a
         , P q a
         , Show (PP p a)
         , Fractional (PP p a)
         ) => P (p / q) a where
  type PP (p / q) a = PP p a
  eval :: proxy (p / q) -> POpts -> a -> m (TT (PP (p / q) a))
eval proxy (p / q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"(/)"
    Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
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 a
a []
    TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
      Left TT (PP q a)
e -> TT (PP q a)
e
      Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq)
         | PP q a
q PP q a -> PP q a -> Bool
forall a. Eq a => a -> a -> Bool
== PP q a
0 -> let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero denominator"
                     in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a)
forall a. String -> Val a
Fail String
msg1) String
"" [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
         | Bool
otherwise ->
            let d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
forall a. Fractional a => a -> a -> a
/ PP q a
q
            in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" / " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]

-- | divide for integrals

--

-- >>> pz @(On (+) (Id * Id) >> (Id ** (DivI Double 1 2))) (3,4)

-- Val 5.0

--

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

type DivIT t p q = (p >> FromIntegral t) / (q >> FromIntegral t)

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


-- | creates a 'Rational' value

--

-- >>> pz @(Id < 21 % 5) (-3.1)

-- Val True

--

-- >>> pz @(Id < 21 % 5) 4.5

-- Val False

--

-- >>> pz @(Fst % Snd) (13,2)

-- Val (13 % 2)

--

-- >>> pz @(13 % Id) 0

-- Fail "(%) zero denominator"

--

-- >>> pz @(4 % 3 + 5 % 7) "asfd"

-- Val (43 % 21)

--

-- >>> pz @(4 -% 7 * 5 -% 3) "asfd"

-- Val (20 % 21)

--

-- >>> pz @(Negate (14 % 3)) ()

-- Val ((-14) % 3)

--

-- >>> pz @(14 % 3) ()

-- Val (14 % 3)

--

-- >>> pz @(Negate (14 % 3) ==! Lift (FromIntegral _) (Negate 5)) ()

-- Val GT

--

-- >>> pz @(14 -% 3 ==! 5 -% 1) "aa"

-- Val GT

--

-- >>> pz @(Negate (14 % 3) ==! Negate 5 % 2) ()

-- Val LT

--

-- >>> pz @(14 -% 3 * 5 -% 1) ()

-- Val (70 % 3)

--

-- >>> pz @(14 % 3 ==! 5 % 1) ()

-- Val LT

--

-- >>> pz @(15 % 3 / 4 % 2) ()

-- Val (5 % 2)

--

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
infixl 8 %

instance ( Integral (PP p x)
         , Integral (PP q x)
         , Eq (PP q x)
         , P p x
         , P q x
         , Show (PP p x)
         , Show (PP q x)
         ) => P (p % q) x where
  type PP (p % q) x = Rational
  eval :: proxy (p % q) -> POpts -> x -> m (TT (PP (p % q) x))
eval proxy (p % q)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"(%)"
    Either (TT Rational) (PP p x, PP q x, TT (PP p x), TT (PP q x))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT Rational) (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
x []
    TT Rational -> m (TT Rational)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Rational -> m (TT Rational)) -> TT Rational -> m (TT Rational)
forall a b. (a -> b) -> a -> b
$ case Either (TT Rational) (PP p x, PP q x, TT (PP p x), TT (PP q x))
lr of
      Left TT Rational
e -> TT Rational
e
      Right (PP p x
p,PP q x
q,TT (PP p x)
pp,TT (PP q x)
qq)
         | PP q x
q PP q x -> PP q x -> Bool
forall a. Eq a => a -> a -> Bool
== PP q x
0 -> let msg1 :: String
msg1 = String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero denominator"
                     in POpts -> Val Rational -> String -> [Tree PE] -> TT Rational
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val Rational
forall a. String -> Val a
Fail String
msg1) String
"" [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp, TT (PP q x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q x)
qq]
         | Bool
otherwise ->
            let z :: (Integer, Integer)
z@(Integer
p1,Integer
q1) = (PP p x -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral PP p x
p, PP q x -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral PP q x
q)
                d :: Rational
d@(Integer
dn :% Integer
dd) = (Integer -> Integer -> Rational) -> (Integer, Integer) -> Rational
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
(%) (Integer, Integer)
z
                zz :: String
zz = if Integer
dn Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
p1 Bool -> Bool -> Bool
&& Integer
dd Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
q1 then String
""
                     else POpts -> String -> ShowS
litVerbose POpts
opts String
" | " (PP p x -> String
forall a. Show a => a -> String
show PP p x
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" % " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PP q x -> String
forall a. Show a => a -> String
show PP q x
q)
            in POpts -> Val Rational -> String -> [Tree PE] -> TT Rational
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Rational -> Val Rational
forall a. a -> Val a
Val Rational
d) (POpts -> Rational -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts Rational
d String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
zz) [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp, TT (PP q x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q x)
qq]

-- | negate a ratio

--

-- >>> pl @'[1 % 1 ,3 -% 2,3 -% 1] ()

-- Present [1 % 1,(-3) % 2,(-3) % 1] ('[1 % 1,(-3) % 2,(-3) % 1] (1 % 1) | ())

-- Val [1 % 1,(-3) % 2,(-3) % 1]

--

-- >>> pl @('[1 % 1 ,Negate (33 % 7), 21 % 4,Signum (7 -% 5)] >> Map (Floor _)) ()

-- Present [1,-5,5,-1] ((>>) [1,-5,5,-1] | {Map [1,-5,5,-1] | [1 % 1,(-33) % 7,21 % 4,(-1) % 1]})

-- Val [1,-5,5,-1]

--

-- >>> pl @('[1 % 1 ,Negate (33 % 7), 21 % 4,Signum (7 -% 5)] >> Map (Ceiling _)) ()

-- Present [1,-4,6,-1] ((>>) [1,-4,6,-1] | {Map [1,-4,6,-1] | [1 % 1,(-33) % 7,21 % 4,(-1) % 1]})

-- Val [1,-4,6,-1]

--

-- >>> pl @('[1 % 1 ,Negate (33 % 7), 21 % 4,Signum (7 -% 5)] >> Map (Truncate _)) ()

-- Present [1,-4,5,-1] ((>>) [1,-4,5,-1] | {Map [1,-4,5,-1] | [1 % 1,(-33) % 7,21 % 4,(-1) % 1]})

-- Val [1,-4,5,-1]

--

-- >>> pl @(5 % 1 / 3 -% 1) 'x'

-- Present (-5) % 3 (5 % 1 / (-3) % 1 = (-5) % 3)

-- Val ((-5) % 3)

--

-- >>> pl @(5 -% 1 / Fst) (3,'x')

-- Present (-5) % 3 ((-5) % 1 / 3 % 1 = (-5) % 3)

-- Val ((-5) % 3)

--

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
infixl 8 -%
type NegateRatioT p q = Negate (p % q)

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


-- | similar to 'negate'

--

-- >>> pz @(Negate Id) 14

-- Val (-14)

--

-- >>> pz @(Negate (Fst * Snd)) (14,3)

-- Val (-42)

--

-- >>> pz @(Negate (15 -% 4)) "abc"

-- Val (15 % 4)

--

-- >>> pz @(Negate (15 % 3)) ()

-- Val ((-5) % 1)

--

-- >>> pz @(Negate (Fst % Snd)) (14,3)

-- Val ((-14) % 3)

--

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

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


-- | similar to 'abs'

--

-- >>> pz @(Abs Id) (-14)

-- Val 14

--

-- >>> pz @(Abs Snd) ("xx",14)

-- Val 14

--

-- >>> pz @(Abs Id) 0

-- Val 0

--

-- >>> pz @(Abs (Negate 44)) "aaa"

-- Val 44

--

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

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

-- | similar to 'div'

--

-- >>> pz @(Div Fst Snd) (10,4)

-- Val 2

--

-- >>> pz @(Div Fst Snd) (10,0)

-- Fail "Div zero denominator"

--

data Div p q deriving Int -> Div p q -> ShowS
[Div p q] -> ShowS
Div p q -> String
(Int -> Div p q -> ShowS)
-> (Div p q -> String) -> ([Div p q] -> ShowS) -> Show (Div p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Div p q -> ShowS
forall k (p :: k) k (q :: k). [Div p q] -> ShowS
forall k (p :: k) k (q :: k). Div p q -> String
showList :: [Div p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Div p q] -> ShowS
show :: Div p q -> String
$cshow :: forall k (p :: k) k (q :: k). Div p q -> String
showsPrec :: Int -> Div p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Div p q -> ShowS
Show
instance ( PP p a ~ PP q a
         , P p a
         , P q a
         , Show (PP p a)
         , Integral (PP p a)
         ) => P (Div p q) a where
  type PP (Div p q) a = PP p a
  eval :: proxy (Div p q) -> POpts -> a -> m (TT (PP (Div p q) a))
eval proxy (Div p q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"Div"
    Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
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 a
a []
    TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
      Left TT (PP q a)
e -> TT (PP q a)
e
      Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
         let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
         in case PP q a
q of
              PP q a
0 -> POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero denominator")) String
"" [Tree PE]
hhs
              PP q a
_ -> let d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
forall a. Integral a => a -> a -> a
`div` PP q a
q
                   in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" `div` " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [Tree PE]
hhs


-- | similar to 'GHC.Real.mod'

--

-- >>> pz @(Mod Fst Snd) (10,3)

-- Val 1

--

-- >>> pz @(Mod Fst Snd) (10,0)

-- Fail "Mod zero denominator"

--

data Mod p q deriving Int -> Mod p q -> ShowS
[Mod p q] -> ShowS
Mod p q -> String
(Int -> Mod p q -> ShowS)
-> (Mod p q -> String) -> ([Mod p q] -> ShowS) -> Show (Mod p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Mod p q -> ShowS
forall k (p :: k) k (q :: k). [Mod p q] -> ShowS
forall k (p :: k) k (q :: k). Mod p q -> String
showList :: [Mod p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Mod p q] -> ShowS
show :: Mod p q -> String
$cshow :: forall k (p :: k) k (q :: k). Mod p q -> String
showsPrec :: Int -> Mod p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Mod p q -> ShowS
Show
instance ( PP p a ~ PP q a
         , P p a
         , P q a
         , Show (PP p a)
         , Integral (PP p a)
         ) => P (Mod p q) a where
  type PP (Mod p q) a = PP p a
  eval :: proxy (Mod p q) -> POpts -> a -> m (TT (PP (Mod p q) a))
eval proxy (Mod p q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"Mod"
    Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
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 a
a []
    TT (PP q a) -> m (TT (PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a) -> m (TT (PP q a))) -> TT (PP q a) -> m (TT (PP q a))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
      Left TT (PP q a)
e -> TT (PP q a)
e
      Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
         let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
         in case PP q a
q of
              PP q a
0 -> POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero denominator")) String
"" [Tree PE]
hhs
              PP q a
_ -> let d :: PP q a
d = PP q a
p PP q a -> PP q a -> PP q a
forall a. Integral a => a -> a -> a
`mod` PP q a
q
                   in POpts -> Val (PP q a) -> String -> [Tree PE] -> TT (PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP q a -> Val (PP q a)
forall a. a -> Val a
Val PP q a
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" `mod` " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
d) [Tree PE]
hhs

-- | similar to 'divMod'

--

-- >>> pz @(DivMod Fst Snd) (10,3)

-- Val (3,1)

--

-- >>> pz @(DivMod Fst Snd) (10,-3)

-- Val (-4,-2)

--

-- >>> pz @(DivMod Fst Snd) (-10,3)

-- Val (-4,2)

--

-- >>> pz @(DivMod Fst Snd) (-10,-3)

-- Val (3,-1)

--

-- >>> pz @(DivMod Fst Snd) (10,0)

-- Fail "DivMod zero denominator"

--

-- >>> pl @(DivMod (Negate Id) 7) 23

-- Present (-4,5) (-23 `divMod` 7 = (-4,5))

-- Val (-4,5)

--

-- >>> pl @(DivMod Fst Snd) (10,-3)

-- Present (-4,-2) (10 `divMod` -3 = (-4,-2))

-- Val (-4,-2)

--

-- >>> pl @(DivMod Fst Snd) (10,0)

-- Error DivMod zero denominator

-- Fail "DivMod zero denominator"

--

-- >>> pl @(DivMod (9 - Fst) (Snd >> Last)) (10,[12,13])

-- Present (-1,12) (-1 `divMod` 13 = (-1,12))

-- Val (-1,12)

--

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

instance ( PP p a ~ PP q a
         , P p a
         , P q a
         , Show (PP p a)
         , Integral (PP p a)
         ) => P (DivMod p q) a where
  type PP (DivMod p q) a = (PP p a, PP p a)
  eval :: proxy (DivMod p q) -> POpts -> a -> m (TT (PP (DivMod p q) a))
eval proxy (DivMod p q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"DivMod"
    Either
  (TT (PP q a, PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP q a, PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
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 a
a []
    TT (PP q a, PP q a) -> m (TT (PP q a, PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a, PP q a) -> m (TT (PP q a, PP q a)))
-> TT (PP q a, PP q a) -> m (TT (PP q a, PP q a))
forall a b. (a -> b) -> a -> b
$ case Either
  (TT (PP q a, PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
      Left TT (PP q a, PP q a)
e -> TT (PP q a, PP q a)
e
      Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
        let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
        in case PP q a
q of
             PP q a
0 -> POpts
-> Val (PP q a, PP q a)
-> String
-> [Tree PE]
-> TT (PP q a, PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a, PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero denominator")) String
"" [Tree PE]
hhs
             PP q a
_ -> let d :: (PP q a, PP q a)
d = PP q a
p PP q a -> PP q a -> (PP q a, PP q a)
forall a. Integral a => a -> a -> (a, a)
`divMod` PP q a
q
                  in POpts
-> Val (PP q a, PP q a)
-> String
-> [Tree PE]
-> TT (PP q a, PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP q a, PP q a) -> Val (PP q a, PP q a)
forall a. a -> Val a
Val (PP q a, PP q a)
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" `divMod` " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> (PP q a, PP q a) -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts (PP q a, PP q a)
d) [Tree PE]
hhs

-- | similar to 'quotRem'

--

-- >>> pz @(QuotRem Fst Snd) (10,3)

-- Val (3,1)

--

-- >>> pz @(QuotRem Fst Snd) (10,-3)

-- Val (-3,1)

--

-- >>> pz @(QuotRem Fst Snd) (-10,-3)

-- Val (3,-1)

--

-- >>> pz @(QuotRem Fst Snd) (-10,3)

-- Val (-3,-1)

--

-- >>> pz @(QuotRem Fst Snd) (10,0)

-- Fail "QuotRem zero denominator"

--

-- >>> pl @(QuotRem (Negate Id) 7) 23

-- Present (-3,-2) (-23 `quotRem` 7 = (-3,-2))

-- Val (-3,-2)

--

-- >>> pl @(QuotRem Fst Snd) (10,-3)

-- Present (-3,1) (10 `quotRem` -3 = (-3,1))

-- Val (-3,1)

--

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

instance ( PP p a ~ PP q a
         , P p a
         , P q a
         , Show (PP p a)
         , Integral (PP p a)
         ) => P (QuotRem p q) a where
  type PP (QuotRem p q) a = (PP p a, PP p a)
  eval :: proxy (QuotRem p q) -> POpts -> a -> m (TT (PP (QuotRem p q) a))
eval proxy (QuotRem p q)
_ POpts
opts a
a = do
    let msg0 :: String
msg0 = String
"QuotRem"
    Either
  (TT (PP q a, PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr <- Inline
-> String
-> Proxy p
-> Proxy q
-> POpts
-> a
-> [Tree PE]
-> m (Either
        (TT (PP q a, PP q a)) (PP p a, PP q a, TT (PP p a), TT (PP q a)))
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 a
a []
    TT (PP q a, PP q a) -> m (TT (PP q a, PP q a))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP q a, PP q a) -> m (TT (PP q a, PP q a)))
-> TT (PP q a, PP q a) -> m (TT (PP q a, PP q a))
forall a b. (a -> b) -> a -> b
$ case Either
  (TT (PP q a, PP q a)) (PP q a, PP q a, TT (PP q a), TT (PP q a))
lr of
      Left TT (PP q a, PP q a)
e -> TT (PP q a, PP q a)
e
      Right (PP q a
p,PP q a
q,TT (PP q a)
pp,TT (PP q a)
qq) ->
        let hhs :: [Tree PE]
hhs = [TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
pp, TT (PP q a) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP q a)
qq]
        in case PP q a
q of
             PP q a
0 -> POpts
-> Val (PP q a, PP q a)
-> String
-> [Tree PE]
-> TT (PP q a, PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP q a, PP q a)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" zero denominator")) String
"" [Tree PE]
hhs
             PP q a
_ -> let d :: (PP q a, PP q a)
d = PP q a
p PP q a -> PP q a -> (PP q a, PP q a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` PP q a
q
                  in POpts
-> Val (PP q a, PP q a)
-> String
-> [Tree PE]
-> TT (PP q a, PP q a)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts ((PP q a, PP q a) -> Val (PP q a, PP q a)
forall a. a -> Val a
Val (PP q a, PP q a)
d) (POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" `quotRem` " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP q a -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP q a
q String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> (PP q a, PP q a) -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts (PP q a, PP q a)
d) [Tree PE]
hhs

-- | similar to 'quot'

data Quot p q deriving Int -> Quot p q -> ShowS
[Quot p q] -> ShowS
Quot p q -> String
(Int -> Quot p q -> ShowS)
-> (Quot p q -> String) -> ([Quot p q] -> ShowS) -> Show (Quot p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Quot p q -> ShowS
forall k (p :: k) k (q :: k). [Quot p q] -> ShowS
forall k (p :: k) k (q :: k). Quot p q -> String
showList :: [Quot p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Quot p q] -> ShowS
show :: Quot p q -> String
$cshow :: forall k (p :: k) k (q :: k). Quot p q -> String
showsPrec :: Int -> Quot p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Quot p q -> ShowS
Show
type QuotT p q = QuotRem p q >> Fst

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

-- | similar to 'rem'

data Rem p q deriving Int -> Rem p q -> ShowS
[Rem p q] -> ShowS
Rem p q -> String
(Int -> Rem p q -> ShowS)
-> (Rem p q -> String) -> ([Rem p q] -> ShowS) -> Show (Rem p q)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k) k (q :: k). Int -> Rem p q -> ShowS
forall k (p :: k) k (q :: k). [Rem p q] -> ShowS
forall k (p :: k) k (q :: k). Rem p q -> String
showList :: [Rem p q] -> ShowS
$cshowList :: forall k (p :: k) k (q :: k). [Rem p q] -> ShowS
show :: Rem p q -> String
$cshow :: forall k (p :: k) k (q :: k). Rem p q -> String
showsPrec :: Int -> Rem p q -> ShowS
$cshowsPrec :: forall k (p :: k) k (q :: k). Int -> Rem p q -> ShowS
Show
type RemT p q = QuotRem p q >> Snd

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

-- | similar to 'even'

--

-- >>> pz @(Map Even) [9,-4,12,1,2,3]

-- Val [False,True,True,False,True,False]

--

-- >>> pz @(Map '(Even,Odd)) [9,-4,12,1,2,3]

-- Val [(False,True),(True,False),(True,False),(False,True),(True,False),(False,True)]

--

data Even deriving Int -> Even -> ShowS
[Even] -> ShowS
Even -> String
(Int -> Even -> ShowS)
-> (Even -> String) -> ([Even] -> ShowS) -> Show Even
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Even] -> ShowS
$cshowList :: [Even] -> ShowS
show :: Even -> String
$cshow :: Even -> String
showsPrec :: Int -> Even -> ShowS
$cshowsPrec :: Int -> Even -> ShowS
Show
type EvenT = Mod Id 2 == 0

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

-- | similar to 'odd'

data Odd deriving Int -> Odd -> ShowS
[Odd] -> ShowS
Odd -> String
(Int -> Odd -> ShowS)
-> (Odd -> String) -> ([Odd] -> ShowS) -> Show Odd
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Odd] -> ShowS
$cshowList :: [Odd] -> ShowS
show :: Odd -> String
$cshow :: Odd -> String
showsPrec :: Int -> Odd -> ShowS
$cshowsPrec :: Int -> Odd -> ShowS
Show
type OddT = Mod Id 2 == 1

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

-- | similar to 'signum'

--

-- >>> pz @(Signum Id) (-14)

-- Val (-1)

--

-- >>> pz @(Signum Id) 14

-- Val 1

--

-- >>> pz @(Signum Id) 0

-- Val 0

--

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

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

-- supports negative numbers unlike readInt

-- | Read a number using base 2 through a maximum of 36 with @t@ a reference to a type

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

instance ( Typeable (PP t x)
         , BetweenT "ReadBase'" 2 36 n
         , Show (PP t x)
         , Num (PP t x)
         , KnownNat n
         , PP p x ~ String
         , P p x
         ) => P (ReadBase' t n p) x where
  type PP (ReadBase' t n p) x = PP t x
  eval :: proxy (ReadBase' t n p)
-> POpts -> x -> m (TT (PP (ReadBase' t n p) x))
eval proxy (ReadBase' t n p)
_ POpts
opts x
x = do
    let n :: Int
n = (KnownNat n, Num Int) => Int
forall (n :: Nat) a. (KnownNat n, Num a) => a
nat @n @Int
        msg0 :: String
msg0 = String
"ReadBase(" 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
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
")"
        t :: String
t = Typeable (PP t x) => String
forall t. Typeable t => String
showT @(PP t x)
    TT String
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) -> 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 Inline
-> POpts
-> String
-> TT String
-> [Tree PE]
-> Either (TT (PP t x)) String
forall a x.
Inline -> POpts -> String -> TT a -> [Tree PE] -> Either (TT x) a
getValueLR Inline
NoInline POpts
opts String
msg0 TT String
pp [] of
      Left TT (PP t x)
e -> TT (PP t x)
e
      Right String
p ->
        case String
p String -> Getting (First Integer) String Integer -> Maybe Integer
forall s a. s -> Getting (First a) s a -> Maybe a
^? Int -> Prism' String Integer
forall a. (HasCallStack, Integral a) => Int -> Prism' String a
Numeric.Lens.base @Integer Int
n of
          Just (Integer -> PP t x
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> PP t x
b) -> 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
b) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> PP t x -> String
forall a. Show a => POpts -> a -> String
showL POpts
opts PP t x
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> ShowS
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " String
p) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]
          Maybe Integer
Nothing -> 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
"invalid base " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n)) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" p=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
p) [TT String -> Tree PE
forall a. TT a -> Tree PE
hh TT String
pp]

-- | Read a number using base 2 through a maximum of 36

--

-- >>> pz @(ReadBase Int 16) "00feD"

-- Val 4077

--

-- >>> pz @(ReadBase Int 16) "-ff"

-- Val (-255)

--

-- >>> pz @(ReadBase Int 2) "10010011"

-- Val 147

--

-- >>> pz @(ReadBase Int 8) "Abff"

-- Fail "invalid base 8"

--

-- >>> pl @(ReadBase Int 16 >> GuardSimple (Id > 0xffff) >> ShowBase 16) "12344"

-- Present "12344" ((>>) "12344" | {ShowBase(16) 12344 | 74564})

-- Val "12344"

--

-- >>> :set -XBinaryLiterals

-- >>> pz @(ReadBase Int 16 >> GuardSimple (Id > 0b10011111) >> ShowBase 16) "7f"

-- Fail "(127 > 159)"

--

-- >>> pl @(ReadBase Int 16) "fFe0"

-- Present 65504 (ReadBase(Int,16) 65504 | "fFe0")

-- Val 65504

--

-- >>> pl @(ReadBase Int 16) "-ff"

-- Present -255 (ReadBase(Int,16) -255 | "-ff")

-- Val (-255)

--

-- >>> pl @(ReadBase Int 16) "ff"

-- Present 255 (ReadBase(Int,16) 255 | "ff")

-- Val 255

--

-- >>> pl @(ReadBase Int 22) "zzz"

-- Error invalid base 22 (ReadBase(Int,22) p=zzz)

-- Fail "invalid base 22"

--

-- >>> pl @((ReadBase Int 16 &&& Id) >> First (ShowBase 16)) "fFe0"

-- Present ("ffe0","fFe0") ((>>) ("ffe0","fFe0") | {(***) ("ffe0","fFe0") | (65504,"fFe0")})

-- Val ("ffe0","fFe0")

--

-- >>> pl @(ReadBase Int 2) "101111"

-- Present 47 (ReadBase(Int,2) 47 | "101111")

-- Val 47

--

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

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

-- | Display a number at base 2 to 36, similar to 'Numeric.showIntAtBase' but passes the sign through

--

-- >>> pz @(ShowBase 16) 4077

-- Val "fed"

--

-- >>> pz @(ShowBase 16) (-255)

-- Val "-ff"

--

-- >>> pz @(ShowBase 2) 147

-- Val "10010011"

--

-- >>> pz @(Lift (ShowBase 2) (Negate 147)) "whatever"

-- Val "-10010011"

--

-- >>> pl @(ShowBase 16) (-123)

-- Present "-7b" (ShowBase(16) -7b | -123)

-- Val "-7b"

--

-- >>> pl @(ShowBase 16) 123

-- Present "7b" (ShowBase(16) 7b | 123)

-- Val "7b"

--

-- >>> pl @(ShowBase 16) 65504

-- Present "ffe0" (ShowBase(16) ffe0 | 65504)

-- Val "ffe0"

--

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

instance ( BetweenT "ShowBase" 2 36 n
         , KnownNat n
         , Integral x
         ) => P (ShowBase n) x where
  type PP (ShowBase n) x = String
  eval :: proxy (ShowBase n) -> POpts -> x -> m (TT (PP (ShowBase n) x))
eval proxy (ShowBase n)
_ POpts
opts x
x =
    let n :: Int
n = (KnownNat n, Num Int) => Int
forall (n :: Nat) a. (KnownNat n, Num a) => a
nat @n @Int
        msg0 :: String
msg0 = String
"ShowBase(" 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
")"
        p :: Integer
p = x -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @Integer x
x
        b :: String
b = Int -> Prism' String Integer
forall a. (HasCallStack, Integral a) => Int -> Prism' String a
Numeric.Lens.base Int
n (Tagged Integer (Identity Integer)
 -> Tagged String (Identity String))
-> Integer -> String
forall t b. AReview t b -> b -> t
# Integer
p
    in TT String -> m (TT String)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT String -> m (TT String)) -> TT String -> m (TT String)
forall a b. (a -> b) -> a -> b
$ POpts -> Val String -> String -> [Tree PE] -> TT String
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val String
forall a. a -> Val a
Val String
b) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> ShowS
litL POpts
opts String
b String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> Integer -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " Integer
p) []

-- | Display a number at base >= 2 but just show as a list of ints: ignores the sign

--

-- >>> pl @(ShowBaseN 16 Id) (256*256*2+256*14+16*7+11)

-- Present [2,0,14,7,11] (ShowBaseN | 16 | 134779)

-- Val [2,0,14,7,11]

--

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

instance ( PP p x ~ a
         , P p x
         , PP n x ~ b
         , P n x
         , Integral a
         , Integral b
         ) => P (ShowBaseN n p) x where
  type PP (ShowBaseN n p) x = [Int]
  eval :: proxy (ShowBaseN n p)
-> POpts -> x -> m (TT (PP (ShowBaseN n p) x))
eval proxy (ShowBaseN n p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"ShowBaseN"
    Either (TT [Int]) (b, a, TT b, TT a)
lr <- Inline
-> String
-> Proxy n
-> Proxy p
-> POpts
-> x
-> [Tree PE]
-> m (Either (TT [Int]) (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 [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 Either (TT [Int]) (b, a, TT b, TT a)
lr of
      Left TT [Int]
e -> TT [Int]
e
      Right (b -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
n,a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int
p,TT b
nn,TT a
pp) ->
         let hhs :: [Tree PE]
hhs = [TT b -> Tree PE
forall a. TT a -> Tree PE
hh TT b
nn, TT a -> Tree PE
forall a. TT a -> Tree PE
hh TT a
pp]
         in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 then POpts -> Val [Int] -> String -> [Tree PE] -> TT [Int]
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val [Int]
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" base must be greater than 1")) String
"" [Tree PE]
hhs
            else let xs :: [Int]
xs = ((Int -> [Int] -> [Int]) -> Int -> [Int] -> [Int])
-> Int -> [Int] -> [Int]
forall a. (a -> a) -> a
fix (\Int -> [Int] -> [Int]
f Int
s -> if Int
sInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
1 then [Int] -> [Int]
forall a. a -> a
id else let (Int
a,Int
b) = Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
s Int
n in Int -> [Int] -> [Int]
f Int
a ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
bInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:)) (Int -> Int
forall a. Num a => a -> a
abs Int
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]
xs) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> Int -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> Int -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " Int
p) [Tree PE]
hhs

-- | convert to bits

--

-- >>> pl @(UnShowBaseN 2 (ToBits 123)) ()

-- Present 123 (UnShowBaseN | 2 | [1,1,1,1,0,1,1])

-- Val 123

--

data ToBits p deriving Int -> ToBits p -> ShowS
[ToBits p] -> ShowS
ToBits p -> String
(Int -> ToBits p -> ShowS)
-> (ToBits p -> String) -> ([ToBits p] -> ShowS) -> Show (ToBits p)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (p :: k). Int -> ToBits p -> ShowS
forall k (p :: k). [ToBits p] -> ShowS
forall k (p :: k). ToBits p -> String
showList :: [ToBits p] -> ShowS
$cshowList :: forall k (p :: k). [ToBits p] -> ShowS
show :: ToBits p -> String
$cshow :: forall k (p :: k). ToBits p -> String
showsPrec :: Int -> ToBits p -> ShowS
$cshowsPrec :: forall k (p :: k). Int -> ToBits p -> ShowS
Show
type ToBitsT p = ShowBaseN 2 p

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

-- | reverse 'ShowBaseN': does not enforce that the values are in range of the given base

--

-- >>> pz @(UnShowBaseN 2 Id) [1,0,0,1,0]

-- Val 18

--

-- >>> pz @(UnShowBaseN Fst Snd) (2,[1,1,1])

-- Val 7

--

-- >>> pz @(UnShowBaseN 16 Id) [7,0,3,1]

-- Val 28721

--

-- >>> pz @(UnShowBaseN 16 Id) [0]

-- Val 0

--

-- >>> pz @(UnShowBaseN 16 Id) []

-- Val 0

--

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

instance ( PP p x ~ [a]
         , PP n x ~ b
         , P n x
         , P p x
         , Integral a
         , Integral b
         ) => P (UnShowBaseN n p) x where
  type PP (UnShowBaseN n p) x = Integer
  eval :: proxy (UnShowBaseN n p)
-> POpts -> x -> m (TT (PP (UnShowBaseN n p) x))
eval proxy (UnShowBaseN n p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"UnShowBaseN"
    Either (TT Integer) (b, [a], TT b, TT [a])
lr <- Inline
-> String
-> Proxy n
-> Proxy p
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT Integer) (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 Integer -> m (TT Integer)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT Integer -> m (TT Integer)) -> TT Integer -> m (TT Integer)
forall a b. (a -> b) -> a -> b
$ case Either (TT Integer) (b, [a], TT b, TT [a])
lr of
      Left TT Integer
e -> TT Integer
e
      Right (b -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Integer
n,[a]
p,TT b
nn,TT [a]
pp) ->
         let xs :: [Integer]
xs = (a -> Integer) -> [a] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map a -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral [a]
p
             hhs :: [Tree PE]
hhs = [TT b -> Tree PE
forall a. TT a -> Tree PE
hh TT b
nn, TT [a] -> Tree PE
forall a. TT a -> Tree PE
hh TT [a]
pp]
         in if Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2 then POpts -> Val Integer -> String -> [Tree PE] -> TT Integer
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val Integer
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" base must be greater than 1")) String
"" [Tree PE]
hhs
            else let b :: Integer
b = (Integer, Integer) -> Integer
forall a b. (a, b) -> b
snd ((Integer, Integer) -> Integer) -> (Integer, Integer) -> Integer
forall a b. (a -> b) -> a -> b
$ (Integer -> (Integer, Integer) -> (Integer, Integer))
-> (Integer, Integer) -> [Integer] -> (Integer, Integer)
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Integer
a (Integer
m,Integer
tot) -> (Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
n, Integer
aInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
mInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
tot)) (Integer
1,Integer
0) [Integer]
xs
                 in POpts -> Val Integer -> String -> [Tree PE] -> TT Integer
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (Integer -> Val Integer
forall a. a -> Val a
Val Integer
b) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> Integer -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " Integer
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> POpts -> String -> [Integer] -> String
forall a. Show a => POpts -> String -> a -> String
showVerbose POpts
opts String
" | " [Integer]
xs) [Tree PE]
hhs

-- | calculate the amount to roundup to the next @n@

--

-- >>> pl @(RoundUp Fst Snd) (3,9)

-- Present 0 (RoundUp 3 9 = 0)

-- Val 0

--

-- >>> pl @(RoundUp Fst Snd) (3,10)

-- Present 2 (RoundUp 3 10 = 2)

-- Val 2

--

-- >>> pl @(RoundUp Fst Snd) (3,11)

-- Present 1 (RoundUp 3 11 = 1)

-- Val 1

--

-- >>> pl @(RoundUp Fst Snd) (3,12)

-- Present 0 (RoundUp 3 12 = 0)

-- Val 0

--

-- >>> pl @(RoundUp 3 0) ()

-- Present 0 (RoundUp 3 0 = 0)

-- Val 0

--

-- >>> pl @(RoundUp 0 10) ()

-- Error RoundUp 'n' cannot be zero

-- Fail "RoundUp 'n' cannot be zero"

--

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

instance ( Integral (PP n x)
         , Show (PP n x)
         , PP n x ~ PP p x
         , P n x
         , P p x
         ) => P (RoundUp n p) x where
  type PP (RoundUp n p) x = PP n x
  eval :: proxy (RoundUp n p) -> POpts -> x -> m (TT (PP (RoundUp n p) x))
eval proxy (RoundUp n p)
_ POpts
opts x
x = do
    let msg0 :: String
msg0 = String
"RoundUp"
    Either (TT (PP p x)) (PP p x, PP p x, TT (PP p x), TT (PP p x))
lr <- Inline
-> String
-> Proxy n
-> Proxy p
-> POpts
-> x
-> [Tree PE]
-> m (Either
        (TT (PP p x)) (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 (PP p x) -> m (TT (PP p x))
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TT (PP p x) -> m (TT (PP p x))) -> TT (PP p x) -> m (TT (PP p x))
forall a b. (a -> b) -> a -> b
$ case Either (TT (PP p x)) (PP p x, PP p x, TT (PP p x), TT (PP p x))
lr of
      Left TT (PP p x)
e -> TT (PP p x)
e
      Right (PP p x
n,PP p x
p,TT (PP p x)
nn,TT (PP p x)
pp) ->
         let hhs :: [Tree PE]
hhs = [TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
nn, TT (PP p x) -> Tree PE
forall a. TT a -> Tree PE
hh TT (PP p x)
pp]
             d :: PP p x
d = (PP p x
nPP p x -> PP p x -> PP p x
forall a. Num a => a -> a -> a
-PP p x
p) PP p x -> PP p x -> PP p x
forall a. Integral a => a -> a -> a
`mod` PP p x
n
         in if PP p x
n PP p x -> PP p x -> Bool
forall a. Eq a => a -> a -> Bool
== PP p x
0 then POpts -> Val (PP p x) -> String -> [Tree PE] -> TT (PP p x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (String -> Val (PP p x)
forall a. String -> Val a
Fail (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" 'n' cannot be zero")) String
"" [Tree PE]
hhs
            else POpts -> Val (PP p x) -> String -> [Tree PE] -> TT (PP p x)
forall a. POpts -> Val a -> String -> [Tree PE] -> TT a
mkNode POpts
opts (PP p x -> Val (PP p x)
forall a. a -> Val a
Val PP p x
d) (String
msg0 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PP p x -> String
forall a. Show a => a -> String
show PP p x
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PP p x -> String
forall a. Show a => a -> String
show PP p x
p String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" = " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PP p x -> String
forall a. Show a => a -> String
show PP p x
d) [Tree PE]
hhs