PhoneNumber.hs

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

{- | An Australian phone number: 10 digits, starting with 0 (a mobile or
landline number with its area code), or with 13 or 18 (a 1300 or 1800
number).

The constructor is not exported (see "ReOC.Primitive.Text1"). A
@PhoneNumber@ is built with the prism '_PhoneNumber' from its digits, with
'parsePhoneNumber', which also accepts spaces, or with 'phoneNumberLiteral'.
-}
module ReOC.Primitive.PhoneNumber (
  PhoneNumber,
  _PhoneNumber,
  parsePhoneNumber,
  phoneNumberText,
  phoneNumberFormatted,
  phoneNumberLiteral,
) where

import Control.Lens (Prism', preview, prism')
import Data.Char (isDigit, isSpace)
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 phone number.
newtype PhoneNumber
  = PhoneNumber Text
  deriving (Eq, Ord, Show, Lift)

{- | A phone number from its 10 digits, with no spaces.

>>> "0491570156" ^? _PhoneNumber
Just (PhoneNumber "0491570156")

>>> "491570156" ^? _PhoneNumber
Nothing
-}
_PhoneNumber :: Prism' Text PhoneNumber
_PhoneNumber =
  prism'
    phoneNumberText
    ( \t ->
        let ds = Text.unpack t
         in if length ds == 10 && all isDigit ds && (take 1 ds == "0" || take 2 ds `elem` ["13", "18"])
              then Just (PhoneNumber t)
              else Nothing
    )

{- | A phone number from text that may have spaces between the digits.

>>> parsePhoneNumber "0491 570 156"
Just (PhoneNumber "0491570156")
-}
parsePhoneNumber :: Text -> Maybe PhoneNumber
parsePhoneNumber =
  preview _PhoneNumber . Text.filter (not . isSpace)

-- | The 10 digits of a phone number.
phoneNumberText :: PhoneNumber -> Text
phoneNumberText (PhoneNumber t) =
  t

{- | A phone number as it is usually written, with spaces: a mobile or a 1300
or 1800 number in groups of 4, 3 and 3 digits, and a landline as its area
code and two groups of 4 digits.

>>> phoneNumberFormatted <$> parsePhoneNumber "0491570156"
Just "0491 570 156"

>>> phoneNumberFormatted <$> parsePhoneNumber "0732101234"
Just "07 3210 1234"
-}
phoneNumberFormatted :: PhoneNumber -> Text
phoneNumberFormatted (PhoneNumber t) =
  let groups ns s =
        case ns of
          [] -> [s]
          n : rest -> let (a, b) = Text.splitAt n s in a : groups rest b
   in Text.unwords
        ( if Text.take 2 t `elem` map Text.pack ["02", "03", "07", "08"]
            then groups [2, 4] t
            else groups [4, 3] t
        )

{- | A @PhoneNumber@ literal, checked when the program is compiled. Spaces
are allowed:

> $$(phoneNumberLiteral "0491 570 156")
-}
phoneNumberLiteral :: String -> Code Q PhoneNumber
phoneNumberLiteral s =
  maybe
    (Code (fail ("phoneNumberLiteral: not an Australian phone number: " <> show s)))
    liftTyped
    (parsePhoneNumber (Text.pack s))