{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Plutarch.Api.V1.Time (
  PPOSIXTime (PPOSIXTime),
  PPOSIXTimeRange,
) where

import Plutarch.Num (PNum)
import PlutusLedgerApi.V1 qualified as Plutus

import Plutarch.Api.V1.Interval (PInterval)
import Plutarch.Lift (
  DerivePConstantViaNewtype (DerivePConstantViaNewtype),
  PConstantDecl,
  PLifted,
  PUnsafeLiftDecl,
 )
import Plutarch.Prelude
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
import Plutarch.Unsafe (punsafeCoerce)

newtype PPOSIXTime (s :: S)
  = PPOSIXTime (Term s PInteger)
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: S) x. Rep (PPOSIXTime s) x -> PPOSIXTime s
forall (s :: S) x. PPOSIXTime s -> Rep (PPOSIXTime s) x
$cto :: forall (s :: S) x. Rep (PPOSIXTime s) x -> PPOSIXTime s
$cfrom :: forall (s :: S) x. PPOSIXTime s -> Rep (PPOSIXTime s) x
Generic)
  deriving anyclass (forall (s :: S). PPOSIXTime s -> Term s (PInner PPOSIXTime)
forall (s :: S) (b :: PType).
Term s (PInner PPOSIXTime)
-> (PPOSIXTime s -> Term s b) -> Term s b
forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PPOSIXTime)
-> (PPOSIXTime s -> Term s b) -> Term s b
$cpmatch' :: forall (s :: S) (b :: PType).
Term s (PInner PPOSIXTime)
-> (PPOSIXTime s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PPOSIXTime s -> Term s (PInner PPOSIXTime)
$cpcon' :: forall (s :: S). PPOSIXTime s -> Term s (PInner PPOSIXTime)
PlutusType, forall (s :: S). Term s (PAsData PPOSIXTime) -> Term s PPOSIXTime
forall (s :: S). Term s PPOSIXTime -> Term s PData
forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
pdataImpl :: forall (s :: S). Term s PPOSIXTime -> Term s PData
$cpdataImpl :: forall (s :: S). Term s PPOSIXTime -> Term s PData
pfromDataImpl :: forall (s :: S). Term s (PAsData PPOSIXTime) -> Term s PPOSIXTime
$cpfromDataImpl :: forall (s :: S). Term s (PAsData PPOSIXTime) -> Term s PPOSIXTime
PIsData, forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
#== :: forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PBool
$c#== :: forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PBool
PEq, PEq PPOSIXTime
forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PBool
forall (t :: PType).
PEq t
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> (forall (s :: S). Term s t -> Term s t -> Term s PBool)
-> PPartialOrd t
#< :: forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PBool
$c#< :: forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PBool
#<= :: forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PBool
$c#<= :: forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PBool
PPartialOrd, PPartialOrd PPOSIXTime
forall (t :: PType). PPartialOrd t -> POrd t
POrd, forall (s :: S).
Term s (PPOSIXTime :--> (PPOSIXTime :--> PPOSIXTime))
forall (a :: PType).
(forall (s :: S). Term s (a :--> (a :--> a)))
-> (forall (s :: S). Term s (a :--> (a :--> a)))
-> (forall (s :: S). Term s (a :--> (a :--> a)))
-> (forall (s :: S). Term s (a :--> (a :--> a)))
-> PIntegral a
prem :: forall (s :: S).
Term s (PPOSIXTime :--> (PPOSIXTime :--> PPOSIXTime))
$cprem :: forall (s :: S).
Term s (PPOSIXTime :--> (PPOSIXTime :--> PPOSIXTime))
pquot :: forall (s :: S).
Term s (PPOSIXTime :--> (PPOSIXTime :--> PPOSIXTime))
$cpquot :: forall (s :: S).
Term s (PPOSIXTime :--> (PPOSIXTime :--> PPOSIXTime))
pmod :: forall (s :: S).
Term s (PPOSIXTime :--> (PPOSIXTime :--> PPOSIXTime))
$cpmod :: forall (s :: S).
Term s (PPOSIXTime :--> (PPOSIXTime :--> PPOSIXTime))
pdiv :: forall (s :: S).
Term s (PPOSIXTime :--> (PPOSIXTime :--> PPOSIXTime))
$cpdiv :: forall (s :: S).
Term s (PPOSIXTime :--> (PPOSIXTime :--> PPOSIXTime))
PIntegral, forall (s :: S). Term s (PPOSIXTime :--> PPOSIXTime)
forall (s :: S). Integer -> Term s PPOSIXTime
forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PPOSIXTime
forall (a :: PType).
(forall (s :: S). Term s a -> Term s a -> Term s a)
-> (forall (s :: S). Term s a -> Term s a -> Term s a)
-> (forall (s :: S). Term s a -> Term s a -> Term s a)
-> (forall (s :: S). Term s (a :--> a))
-> (forall (s :: S). Term s (a :--> a))
-> (forall (s :: S). Term s (a :--> a))
-> (forall (s :: S). Integer -> Term s a)
-> PNum a
pfromInteger :: forall (s :: S). Integer -> Term s PPOSIXTime
$cpfromInteger :: forall (s :: S). Integer -> Term s PPOSIXTime
psignum :: forall (s :: S). Term s (PPOSIXTime :--> PPOSIXTime)
$cpsignum :: forall (s :: S). Term s (PPOSIXTime :--> PPOSIXTime)
pabs :: forall (s :: S). Term s (PPOSIXTime :--> PPOSIXTime)
$cpabs :: forall (s :: S). Term s (PPOSIXTime :--> PPOSIXTime)
pnegate :: forall (s :: S). Term s (PPOSIXTime :--> PPOSIXTime)
$cpnegate :: forall (s :: S). Term s (PPOSIXTime :--> PPOSIXTime)
#* :: forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PPOSIXTime
$c#* :: forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PPOSIXTime
#- :: forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PPOSIXTime
$c#- :: forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PPOSIXTime
#+ :: forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PPOSIXTime
$c#+ :: forall (s :: S).
Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PPOSIXTime
PNum, forall (s :: S). Bool -> Term s PPOSIXTime -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
pshow' :: forall (s :: S). Bool -> Term s PPOSIXTime -> Term s PString
$cpshow' :: forall (s :: S). Bool -> Term s PPOSIXTime -> Term s PString
PShow)
instance DerivePlutusType PPOSIXTime where type DPTStrat _ = PlutusTypeNewtype

instance PUnsafeLiftDecl PPOSIXTime where type PLifted PPOSIXTime = Plutus.POSIXTime
deriving via
  (DerivePConstantViaNewtype Plutus.POSIXTime PPOSIXTime PInteger)
  instance
    PConstantDecl Plutus.POSIXTime

type PPOSIXTimeRange = PInterval PPOSIXTime

newtype Flip f a b = Flip (f b a) deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Rep (Flip @k @k f a b) x -> Flip @k @k f a b
forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Flip @k @k f a b -> Rep (Flip @k @k f a b) x
$cto :: forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Rep (Flip @k @k f a b) x -> Flip @k @k f a b
$cfrom :: forall k k (f :: k -> k -> Type) (a :: k) (b :: k) x.
Flip @k @k f a b -> Rep (Flip @k @k f a b) x
Generic)

instance PTryFrom PData (PAsData PPOSIXTime) where
  type PTryFromExcess PData (PAsData PPOSIXTime) = Flip Term PPOSIXTime
  ptryFrom' :: forall (s :: S) (r :: PType).
Term s PData
-> ((Term s (PAsData PPOSIXTime),
     Reduce (PTryFromExcess PData (PAsData PPOSIXTime) s))
    -> Term s r)
-> Term s r
ptryFrom' Term s PData
opq = forall (r :: PType) (s :: S) a.
TermCont @r s a -> (a -> Term s r) -> Term s r
runTermCont forall a b. (a -> b) -> a -> b
$ do
    (Term s (PAsData PInteger)
wrapped :: Term _ (PAsData PInteger), Term s PInteger
unwrapped :: Term _ PInteger) <-
      forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ forall (b :: PType) (a :: PType) (s :: S) (r :: PType).
PTryFrom a b =>
Term s a
-> ((Term s b, Reduce (PTryFromExcess a b s)) -> Term s r)
-> Term s r
ptryFrom @(PAsData PInteger) Term s PData
opq
    forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall a b. (a -> b) -> a -> b
$ \() -> Term s r
f -> forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s PInteger
0 forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#<= Term s PInteger
unwrapped) (() -> Term s r
f ()) (forall (s :: S) (a :: PType). Term s PString -> Term s a
ptraceError Term s PString
"ptryFrom(POSIXTime): must be positive")
    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s (PAsData PInteger)
wrapped, forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s PInteger -> PPOSIXTime s
PPOSIXTime Term s PInteger
unwrapped)