Percentage.hs

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

{- | A whole percentage, from 0 to 100.

The constructor is not exported (see "ReOC.Primitive.Text1"). A
@Percentage@ is built with the prism '_Percentage' or with
'percentageLiteral'.
-}
module ReOC.Primitive.Percentage (
  Percentage,
  _Percentage,
  percentageNatural,
  percentageLiteral,
) 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 whole percentage, from 0 to 100.
newtype Percentage
  = Percentage Natural
  deriving (Eq, Ord, Show, Lift)

{- | A whole percentage, from 0 to 100.

>>> (30 :: Natural) ^? _Percentage
Just (Percentage 30)

>>> (101 :: Natural) ^? _Percentage
Nothing
-}
_Percentage :: Prism' Natural Percentage
_Percentage =
  prism'
    percentageNatural
    (\n -> if n <= 100 then Just (Percentage n) else Nothing)

-- | The number of a @Percentage@.
percentageNatural :: Percentage -> Natural
percentageNatural (Percentage n) =
  n

{- | A @Percentage@ literal, checked when the program is compiled:

> $$(percentageLiteral 30)
-}
percentageLiteral :: Natural -> Code Q Percentage
percentageLiteral n =
  maybe
    (Code (fail ("percentageLiteral: more than 100: " <> show n)))
    liftTyped
    (preview _Percentage n)