{-# 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
dataStructure s :: 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
== 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
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 t :: Tree Text
t s' :: 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
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 t' :: 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 t :: Tree Text
t s' :: Text
s' = case Tree Text -> Text -> Either Bool (Tree Text)
getNext Tree Text
t Text
s' of
Left _ -> Tree Text -> Text -> Either Bool (Tree Text)
getNext Tree Text
t "*"
r :: 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 [] _ t :: 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 (c :: Text
c : cs :: [Text]
cs) prev :: [Text]
prev t :: Tree Text
t = case Tree Text -> Text -> Either Bool (Tree Text)
getNextWithStar Tree Text
t Text
c of
Left b :: 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
c Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
prev)
Right t' :: 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 _ AtLeaf = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
output _ (OffEnd True x :: 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
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
x
output (OffEnd _ x :: Text
x) _
| 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
== '.') 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
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
- 2) [Text]
ss
| Bool
otherwise = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
x
output _ _ = 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
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