{-# LANGUAGE OverloadedStrings #-}
module Network.PublicSuffixList.Lookup (effectiveTLDPlusOne, effectiveTLDPlusOne', isSuffix, isSuffix') where
import qualified Data.Map as M
import Data.Maybe (isNothing)
import qualified Data.Text as T
import qualified Network.PublicSuffixList.DataStructure as DS
import Network.PublicSuffixList.Types
data LookupResult = Inside | AtLeaf | OffEnd Bool T.Text
deriving (LookupResult -> LookupResult -> Bool
(LookupResult -> LookupResult -> Bool)
-> (LookupResult -> LookupResult -> Bool) -> Eq LookupResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LookupResult -> LookupResult -> Bool
$c/= :: LookupResult -> LookupResult -> Bool
== :: LookupResult -> LookupResult -> Bool
$c== :: LookupResult -> LookupResult -> Bool
Eq)
effectiveTLDPlusOne' :: DataStructure -> T.Text -> Maybe T.Text
effectiveTLDPlusOne' :: DataStructure -> Text -> Maybe Text
effectiveTLDPlusOne' DataStructure
dataStructure Text
s
| [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ss Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = Maybe Text
forall a. Maybe a
Nothing
| Bool
otherwise = LookupResult -> LookupResult -> Maybe Text
output LookupResult
rulesResult LookupResult
exceptionResult
where ss :: [Text]
ss = Text -> Text -> [Text]
T.splitOn Text
"." Text
s
ps :: [Text]
ps = [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
ss
exceptionResult :: LookupResult
exceptionResult = [Text] -> [Text] -> Tree Text -> LookupResult
recurse [Text]
ps [] (Tree Text -> LookupResult) -> Tree Text -> LookupResult
forall a b. (a -> b) -> a -> b
$ DataStructure -> Tree Text
forall a b. (a, b) -> b
snd DataStructure
dataStructure
rulesResult :: LookupResult
rulesResult = [Text] -> [Text] -> Tree Text -> LookupResult
recurse [Text]
ps [] (Tree Text -> LookupResult) -> Tree Text -> LookupResult
forall a b. (a -> b) -> a -> b
$ DataStructure -> Tree Text
forall a b. (a, b) -> a
fst DataStructure
dataStructure
getNext :: Tree T.Text -> T.Text -> Either Bool (Tree T.Text)
getNext :: Tree Text -> Text -> Either Bool (Tree Text)
getNext Tree Text
t Text
s' = case Text -> Map Text (Tree Text) -> Maybe (Tree Text)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
s' (Map Text (Tree Text) -> Maybe (Tree Text))
-> Map Text (Tree Text) -> Maybe (Tree Text)
forall a b. (a -> b) -> a -> b
$ Tree Text -> Map Text (Tree Text)
forall e. Tree e -> Map e (Tree e)
children Tree Text
t of
Maybe (Tree Text)
Nothing -> Bool -> Either Bool (Tree Text)
forall a b. a -> Either a b
Left (Map Text (Tree Text) -> Bool
forall k a. Map k a -> Bool
M.null (Map Text (Tree Text) -> Bool) -> Map Text (Tree Text) -> Bool
forall a b. (a -> b) -> a -> b
$ Tree Text -> Map Text (Tree Text)
forall e. Tree e -> Map e (Tree e)
children Tree Text
t)
Just Tree Text
t' -> Tree Text -> Either Bool (Tree Text)
forall a b. b -> Either a b
Right Tree Text
t'
getNextWithStar :: Tree Text -> Text -> Either Bool (Tree Text)
getNextWithStar Tree Text
t Text
s' = case Tree Text -> Text -> Either Bool (Tree Text)
getNext Tree Text
t Text
s' of
Left Bool
_ -> Tree Text -> Text -> Either Bool (Tree Text)
getNext Tree Text
t Text
"*"
Either Bool (Tree Text)
r -> Either Bool (Tree Text)
r
recurse :: [T.Text] -> [T.Text] -> Tree T.Text -> LookupResult
recurse :: [Text] -> [Text] -> Tree Text -> LookupResult
recurse [] [Text]
_ Tree Text
t
| Map Text (Tree Text) -> Bool
forall k a. Map k a -> Bool
M.null (Map Text (Tree Text) -> Bool) -> Map Text (Tree Text) -> Bool
forall a b. (a -> b) -> a -> b
$ Tree Text -> Map Text (Tree Text)
forall e. Tree e -> Map e (Tree e)
children Tree Text
t = LookupResult
AtLeaf
| Bool
otherwise = LookupResult
Inside
recurse (Text
c : [Text]
cs) [Text]
prev Tree Text
t = case Tree Text -> Text -> Either Bool (Tree Text)
getNextWithStar Tree Text
t Text
c of
Left Bool
b -> Bool -> Text -> LookupResult
OffEnd Bool
b (Text -> LookupResult) -> Text -> LookupResult
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"." (Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
prev)
Right Tree Text
t' -> [Text] -> [Text] -> Tree Text -> LookupResult
recurse [Text]
cs (Text
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
prev) Tree Text
t'
output :: LookupResult -> LookupResult -> Maybe Text
output LookupResult
_ LookupResult
AtLeaf = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
output LookupResult
_ (OffEnd Bool
True Text
x) = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
tail ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
"." Text
x
output (OffEnd Bool
_ Text
x) LookupResult
_
| Maybe Char -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Char -> Bool) -> Maybe Char -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Maybe Char
T.find (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') Text
x = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"." ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
ss Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) [Text]
ss
| Bool
otherwise = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
output LookupResult
_ LookupResult
_ = Maybe Text
forall a. Maybe a
Nothing
effectiveTLDPlusOne :: T.Text -> Maybe T.Text
effectiveTLDPlusOne :: Text -> Maybe Text
effectiveTLDPlusOne = DataStructure -> Text -> Maybe Text
effectiveTLDPlusOne' DataStructure
DS.dataStructure
isSuffix' :: DataStructure -> T.Text -> Bool
isSuffix' :: DataStructure -> Text -> Bool
isSuffix' DataStructure
dataStructure = Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool) -> (Text -> Maybe Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DataStructure -> Text -> Maybe Text
effectiveTLDPlusOne' DataStructure
dataStructure
isSuffix :: T.Text -> Bool
isSuffix :: Text -> Bool
isSuffix = Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool) -> (Text -> Maybe Text) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
effectiveTLDPlusOne