GrossWeight.hs

{-# LANGUAGE DeriveLift #-}
{-# OPTIONS_GHC -Wall #-}

{- | The maximum gross weight of a type of RPA, in grams: more than 0 g and not
more than 25 kg.

The operations manual is written for RPA of not more than 25 kg; heavier
RPA have requirements (and RePL training a safety case) that it does not
cover. The constructor is not exported (see "ReOC.Primitive.Text1"). A
@GrossWeight@ is built with the prism '_GrossWeight' or with
'grossWeightLiteral'.
-}
module ReOC.Primitive.GrossWeight (
  GrossWeight,
  _GrossWeight,
  grossWeightGrams,
  grossWeightLiteral,
) where

import Control.Lens (Prism', preview, prism')
import Language.Haskell.TH.Syntax (Code (..), Lift, Q, liftTyped)
import Numeric.Natural (Natural)

{- $setup
>>> import Control.Lens ((^?))
-}

-- | A maximum gross weight, in grams, from 1 g to 25 kg.
newtype GrossWeight
  = GrossWeight Natural
  deriving (Eq, Ord, Show, Lift)

{- | A maximum gross weight, in grams, from 1 g to 25 kg.

>>> (1999 :: Natural) ^? _GrossWeight
Just (GrossWeight 1999)

>>> (25001 :: Natural) ^? _GrossWeight
Nothing
-}
_GrossWeight :: Prism' Natural GrossWeight
_GrossWeight =
  prism'
    grossWeightGrams
    (\n -> if n >= 1 && n <= 25000 then Just (GrossWeight n) else Nothing)

-- | The weight, in grams.
grossWeightGrams :: GrossWeight -> Natural
grossWeightGrams (GrossWeight n) =
  n

{- | A @GrossWeight@ literal, in grams, checked when the program is compiled:

> $$(grossWeightLiteral 1999)
-}
grossWeightLiteral :: Natural -> Code Q GrossWeight
grossWeightLiteral n =
  maybe
    (Code (fail ("grossWeightLiteral: not from 1 g to 25 kg: " <> show n)))
    liftTyped
    (preview _GrossWeight n)