{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-ignore-interface-pragmas #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -fno-specialise #-}

module PlutusLedgerApi.V4.Data.Time
  ( POSIXTime (..)
  , POSIXTimeRange
  , pattern POSIXTimeRange
  , matchPOSIXTimeRange
  , fromInclusive
  , untilExclusive
  ) where

import PlutusTx.Prelude

import Control.DeepSeq (NFData)
import GHC.Generics (Generic)
import PlutusLedgerApi.V1.Data.Time (POSIXTime (..))
import PlutusTx qualified
import PlutusTx.AsData qualified as PlutusTx
import PlutusTx.Blueprint (ConstructorSchema (..), Schema (..))
import PlutusTx.Blueprint.Class (HasBlueprintSchema (schema))
import PlutusTx.Blueprint.Definition
  ( HasBlueprintDefinition (..)
  , HasSchemaDefinition
  , Unrolled
  , definitionIdFromType
  , definitionRef
  )
import PlutusTx.Blueprint.Definition.TF (Nub)
import PlutusTx.Blueprint.Schema.Annotation (SchemaInfo (..), emptySchemaInfo)
import PlutusTx.Lift (makeLift)
import Prettyprinter (Pretty (pretty), comma, (<+>))
import Prelude qualified as Haskell

PlutusTx.asData
  [d|
    data POSIXTimeRange = POSIXTimeRange
      { -- 'Nothing' means negative infinity.
        fromInclusive :: Haskell.Maybe POSIXTime
      , -- 'Nothing' means positive infinity.
        untilExclusive :: Haskell.Maybe POSIXTime
      }
      deriving stock (Haskell.Eq, Haskell.Show, Generic)
      deriving newtype (PlutusTx.FromData, PlutusTx.UnsafeFromData, PlutusTx.ToData)
      deriving anyclass (NFData)
    |]

instance HasBlueprintDefinition POSIXTimeRange where
  type
    Unroll POSIXTimeRange =
      Nub (POSIXTimeRange ': Unrolled (Haskell.Maybe POSIXTime))
  definitionId :: DefinitionId
definitionId = forall t. Typeable t => DefinitionId
definitionIdFromType @POSIXTimeRange

instance
  HasSchemaDefinition (Haskell.Maybe POSIXTime) referencedTypes
  => HasBlueprintSchema POSIXTimeRange referencedTypes
  where
  {-# INLINEABLE schema #-}
  schema :: Schema referencedTypes
schema =
    SchemaInfo
-> ConstructorSchema referencedTypes -> Schema referencedTypes
forall (referencedTypes :: [*]).
SchemaInfo
-> ConstructorSchema referencedTypes -> Schema referencedTypes
SchemaConstructor
      SchemaInfo
emptySchemaInfo {title = Haskell.Just "POSIXTimeRange"}
      ( Natural
-> [Schema referencedTypes] -> ConstructorSchema referencedTypes
forall (referencedTypes :: [*]).
Natural
-> [Schema referencedTypes] -> ConstructorSchema referencedTypes
MkConstructorSchema
          Natural
0
          [ forall t (ts :: [*]). HasBlueprintDefinition t => Schema ts
definitionRef @(Haskell.Maybe POSIXTime) @referencedTypes
          , forall t (ts :: [*]). HasBlueprintDefinition t => Schema ts
definitionRef @(Haskell.Maybe POSIXTime) @referencedTypes
          ]
      )

instance Pretty POSIXTimeRange where
  pretty :: forall ann. POSIXTimeRange -> Doc ann
pretty (POSIXTimeRange Maybe POSIXTime
lo Maybe POSIXTime
hi) = Doc ann
prettyFrom Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
prettyUntil
    where
      prettyFrom :: Doc ann
prettyFrom = case Maybe POSIXTime
lo of
        Maybe POSIXTime
Haskell.Nothing -> Doc ann
"(-Inf"
        Haskell.Just POSIXTime
t -> Doc ann
"[" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> POSIXTime -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. POSIXTime -> Doc ann
pretty POSIXTime
t
      prettyUntil :: Doc ann
prettyUntil = case Maybe POSIXTime
hi of
        Maybe POSIXTime
Haskell.Nothing -> Doc ann
"+Inf)"
        Haskell.Just POSIXTime
t -> POSIXTime -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. POSIXTime -> Doc ann
pretty POSIXTime
t Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
")"

deriveEq ''POSIXTimeRange
$(makeLift ''POSIXTimeRange)