ARN.hs

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

{- | A CASA Aviation Reference Number: one or more digits.

The constructor is not exported (see "ReOC.Primitive.Text1"). An @ARN@ is
built with the prism '_ARN' or with 'arnLiteral'.
-}
module ReOC.Primitive.ARN (
  ARN,
  _ARN,
  arnText,
  arnLiteral,
) where

import Control.Lens (Prism', preview, prism')
import Data.Char (isDigit)
import Data.Text (Text)
import qualified Data.Text as Text
import Language.Haskell.TH.Syntax (Code (..), Lift, Q, liftTyped)

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

-- | An Aviation Reference Number.
newtype ARN
  = ARN Text
  deriving (Eq, Ord, Show, Lift)

{- | An ARN from its digits.

>>> "9990102" ^? _ARN
Just (ARN "9990102")

>>> "ARN 9990102" ^? _ARN
Nothing
-}
_ARN :: Prism' Text ARN
_ARN =
  prism'
    arnText
    (\t -> if not (Text.null t) && Text.all isDigit t then Just (ARN t) else Nothing)

-- | The digits of an ARN.
arnText :: ARN -> Text
arnText (ARN t) =
  t

{- | An @ARN@ literal, checked when the program is compiled:

> $$(arnLiteral "9990102")
-}
arnLiteral :: String -> Code Q ARN
arnLiteral s =
  maybe
    (Code (fail ("arnLiteral: not an ARN: " <> show s)))
    liftTyped
    (preview _ARN (Text.pack s))