Postcode.hs

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

{- | An Australian postcode: 4 digits.

The constructor is not exported (see "ReOC.Primitive.Text1"). A @Postcode@
is built with the prism '_Postcode' or with 'postcodeLiteral'.
-}
module ReOC.Primitive.Postcode (
  Postcode,
  _Postcode,
  postcodeText,
  postcodeLiteral,
) 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 Australian postcode.
newtype Postcode
  = Postcode Text
  deriving (Eq, Ord, Show, Lift)

{- | A postcode from its 4 digits.

>>> "4000" ^? _Postcode
Just (Postcode "4000")

>>> "400" ^? _Postcode
Nothing
-}
_Postcode :: Prism' Text Postcode
_Postcode =
  prism'
    postcodeText
    (\t -> if Text.length t == 4 && Text.all isDigit t then Just (Postcode t) else Nothing)

-- | The 4 digits of a postcode.
postcodeText :: Postcode -> Text
postcodeText (Postcode t) =
  t

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

> $$(postcodeLiteral "4000")
-}
postcodeLiteral :: String -> Code Q Postcode
postcodeLiteral s =
  maybe
    (Code (fail ("postcodeLiteral: not a postcode: " <> show s)))
    liftTyped
    (preview _Postcode (Text.pack s))