ABN.hs

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

{- | An Australian Business Number: 11 digits whose check digits are correct.

The constructor is not exported (see "ReOC.Primitive.Text1"). An @ABN@ is
built with the prism '_ABN' from its 11 digits, with 'parseABN', which also
accepts spaces, or with 'abnLiteral'.
-}
module ReOC.Primitive.ABN (
  ABN,
  _ABN,
  parseABN,
  abnText,
  abnFormatted,
  abnLiteral,
) where

import Control.Lens (Prism', preview, prism')
import Data.Char (digitToInt, 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 Business Number.
newtype ABN
  = ABN Text
  deriving (Eq, Ord, Show, Lift)

{- | An ABN from its 11 digits, with no spaces. The check digits must be
correct.

>>> "51824753556" ^? _ABN
Just (ABN "51824753556")

>>> "51824753557" ^? _ABN
Nothing

>>> "51 824 753 556" ^? _ABN
Nothing
-}
_ABN :: Prism' Text ABN
_ABN =
  prism'
    abnText
    ( \t ->
        let ds = Text.unpack t
         in if length ds == 11 && all isDigit ds && checksum (map digitToInt ds)
              then Just (ABN t)
              else Nothing
    )
 where
  checksum ds =
    case ds of
      d : rest -> sum (zipWith (*) weights ((d - 1) : rest)) `mod` 89 == 0
      [] -> False
  weights =
    [10, 1, 3, 5, 7, 9, 11, 13, 15, 17, 19]

{- | An ABN from text that may have spaces between the digits.

>>> parseABN "51 824 753 556"
Just (ABN "51824753556")
-}
parseABN :: Text -> Maybe ABN
parseABN =
  preview _ABN . Text.filter (not . isSpace)

-- | The 11 digits of an ABN.
abnText :: ABN -> Text
abnText (ABN t) =
  t

{- | An ABN as it is usually written, with spaces.

>>> abnFormatted <$> parseABN "51824753556"
Just "51 824 753 556"
-}
abnFormatted :: ABN -> Text
abnFormatted (ABN t) =
  let (a, r1) = Text.splitAt 2 t
      (b, r2) = Text.splitAt 3 r1
      (c, d) = Text.splitAt 3 r2
   in Text.unwords [a, b, c, d]

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

> $$(abnLiteral "51 824 753 556")
-}
abnLiteral :: String -> Code Q ABN
abnLiteral s =
  maybe
    (Code (fail ("abnLiteral: not an ABN: " <> show s)))
    liftTyped
    (parseABN (Text.pack s))