-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Reimplementation of some syntax sugar
--
-- You need the following module pragmas to make it work smoothly:
--
-- @
-- {-\# LANGUAGE NoApplicativeDo, RebindableSyntax \#-}
-- {-\# OPTIONS_GHC -Wno-unused-do-bind \#-}
-- @

module Indigo.Rebinded
  ( -- * @if/then/else@ construct
    ifThenElse

  -- * Numerical literals resolution
  , fromInteger
  , nat
  , int
  , mutez

  -- * Re-exports
  , IsLabel (..)
  ) where

import qualified Prelude as P
import qualified Data.Kind as Kind

import Indigo.Internal
import Indigo.Frontend
import Indigo.Backend.Scope
import Indigo.Backend.Conditional (IfConstraint)
import Indigo.Lorentz
import Util.Label (IsLabel(..))

----------------------------------------------------------------------------
-- @if/then/else@ construct
----------------------------------------------------------------------------

-- | Defines semantics of @if ... then ... else ...@ construction for Indigo
-- where the predicate is a generic @exa@ for which @IsExpr exa Bool@ holds
ifThenElse
  :: (IfConstraint a b, IsExpr exa Bool)
  => exa
  -> IndigoM a
  -> IndigoM b
  -> IndigoM (RetVars a)
ifThenElse :: exa -> IndigoM a -> IndigoM b -> IndigoM (RetVars a)
ifThenElse cond :: exa
cond = Expr Bool -> IndigoM a -> IndigoM b -> IndigoM (RetVars a)
forall a b ex.
(IfConstraint a b, ex :~> Bool) =>
ex -> IndigoM a -> IndigoM b -> IndigoM (RetVars a)
if_ (exa -> Expr (ExprType exa)
forall a. ToExpr a => a -> Expr (ExprType a)
toExpr exa
cond)

----------------------------------------------------------------------------
-- Numerical literals resolution
----------------------------------------------------------------------------

-- | Kind used for 'NumType' as part of the disambiguation machinery.
data NumKind = Nat | Int | Mtz

-- | Disambiguation type used in 'fromInteger' that links a single 'NumKind' to
-- the numeric type to resolve to.
data NumType (n :: NumKind) (t :: Kind.Type) where
  NNat :: NumType 'Nat Natural
  NInt :: NumType 'Int Integer
  NMtz :: NumType 'Mtz Mutez

-- | Numerical literal disambiguation value for a 'Natural', see 'fromInteger'.
nat :: NumType 'Nat Natural
nat :: NumType 'Nat Natural
nat = NumType 'Nat Natural
NNat

-- | Numerical literal disambiguation value for an 'Integer', see 'fromInteger'.
int :: NumType 'Int Integer
int :: NumType 'Int Integer
int = NumType 'Int Integer
NInt

-- | Numerical literal disambiguation value for a 'Mutez', see 'fromInteger'.
mutez :: NumType 'Mtz Mutez
mutez :: NumType 'Mtz Mutez
mutez = NumType 'Mtz Mutez
NMtz

-- | Defines numerical literals resolution for Indigo.
--
-- It is implemented with an additional 'NumType' argument that disambiguates
-- the resulting type.
-- This allows, for example, @1 int@ to be resolved to @1 :: Integer@.
fromInteger :: Integer -> NumType n t -> t
fromInteger :: Integer -> NumType n t -> t
fromInteger val :: Integer
val = \case
  NNat -> Integer -> t
forall a. Num a => Integer -> a
P.fromInteger Integer
val
  NInt -> t
Integer
val
  NMtz -> Word32 -> Mutez
toMutez (Integer -> Word32
forall a. Num a => Integer -> a
P.fromInteger Integer
val)