module HPhone (HPhone.lookup, HPhone.validate, CountryCodeAbbr, PhoneNumber, Phone(..)) where

import PhoneNumberMetadata
import qualified Data.Map.Strict as Map
import Data.Maybe (isNothing, catMaybes, fromJust)
import Data.List
import Text.Regex.PCRE

type CountryCodeAbbr = String
type TerritoryMap    = Map.Map CountryCodeAbbr Territory

data Phone = Phone
  { number      :: String
  , code        :: String
  , countryAbbr :: String
  , numberType  :: String
  } deriving (Eq, Read, Show)

ts:: [Territory]
ts = territories phoneNumberMetadata

territoryMap:: TerritoryMap
territoryMap = Map.fromList [(abbreviation t, t) | t <- ts]

{------------------- APIs follow ------------------}

{-| Phone number must not include country code. Leading zeroes are allowed -}
validate :: PhoneNumber -> CountryCodeAbbr -> Bool
validate phone abbr
  | isNothing $ HPhone.lookup phone abbr = False
  | otherwise = True

{-| Phone number must not include country code. Leading zeroes are allowed -}
lookup:: PhoneNumber -> CountryCodeAbbr -> Maybe Phone
lookup phone abbr = lookupPhone (ltrim phone) abbr territoryMap
  where ltrim = dropWhile (`elem` "0")

normalize :: PhoneNumber -> PhoneNumber
normalize _ = undefined

lookupPhone :: PhoneNumber -> CountryCodeAbbr -> TerritoryMap -> Maybe Phone
lookupPhone phoneNumber abbr territoryMap =
  Map.lookup abbr territoryMap                                              >>= \t ->
  find (isMatch phoneNumber) (catMaybes $ phoneNumberPatterns t)            >>= \numberPatterns ->
  return $ constructResponse phoneNumber t $ phoneNumberType numberPatterns

isMatch :: PhoneNumber -> PhoneNumberPatterns -> Bool
isMatch phone (PhoneNumberPatterns _ (Just np) _ _)   = phone =~ ("^(" ++ np ++ ")$")::Bool
isMatch phone (PhoneNumberPatterns _ _ (Just pp) _)   = phone =~ ("^(" ++ pp ++ ")$")::Bool
isMatch phone PhoneNumberPatterns {}                  = False

phoneNumberPatterns:: Territory -> [Maybe PhoneNumberPatterns]
phoneNumberPatterns t =
  [ mobile t
  , fixedLine t
  , pager t
  , tollFree t
  , premiumRate t
  , sharedCost t
  , personalNumber t
  , voip t
  , uan t
  , voicemail t
  ]

constructResponse:: PhoneNumber -> Territory -> String -> Phone
constructResponse number territory phoneType =
  Phone { number      = number
        , code        = countryCode territory
        , countryAbbr = abbreviation territory
        , numberType  = phoneType
        }