module Network.URI.TLD (parseTLD, separateTLD, separateTLD') where
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Network.URI as URI
import Network.URI.TLD.Internal
separateTLD :: URI.URI -> Maybe (Text, Text, Text)
separateTLD uri =
case URI.uriAuthority uri of
Nothing ->
Nothing
Just uriAuth ->
separateTLD' $ Text.pack $ URI.uriRegName uriAuth
separateTLD' :: Text -> Maybe (Text, Text, Text)
separateTLD' domain = helper "" "" $ Text.toLower domain
where
helper _ _ "" = Nothing
helper subdomain domain tld =
if Set.member tld $(tldSet) then
Just (subdomain, domain, tld)
else
let subdomain' =
if Text.null subdomain then
domain
else
Text.concat [subdomain, ".", domain]
in
let (domain', tld') = Text.break (== '.') tld in
if Text.null domain' then
Nothing
else
let (head, tld'') = Text.splitAt 1 tld' in
if head /= "." then
Nothing
else
helper subdomain' domain' tld''
parseTLD :: String -> Maybe (Text, Text, Text)
parseTLD s = case URI.parseURI s of
Nothing ->
Nothing
Just uri ->
separateTLD uri