{-|
This module is only exported for the use of the 'publicsuffixlistcreate' package.
Every one else should consider everything in this file to be opaque.
-}

module Network.PublicSuffixList.Types where

import qualified Data.Map             as M
import qualified Data.Text            as T

newtype Tree e = Node { Tree e -> Map e (Tree e)
children :: M.Map e (Tree e) }
  deriving (Int -> Tree e -> ShowS
[Tree e] -> ShowS
Tree e -> String
(Int -> Tree e -> ShowS)
-> (Tree e -> String) -> ([Tree e] -> ShowS) -> Show (Tree e)
forall e. Show e => Int -> Tree e -> ShowS
forall e. Show e => [Tree e] -> ShowS
forall e. Show e => Tree e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree e] -> ShowS
$cshowList :: forall e. Show e => [Tree e] -> ShowS
show :: Tree e -> String
$cshow :: forall e. Show e => Tree e -> String
showsPrec :: Int -> Tree e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> Tree e -> ShowS
Show, Tree e -> Tree e -> Bool
(Tree e -> Tree e -> Bool)
-> (Tree e -> Tree e -> Bool) -> Eq (Tree e)
forall e. Eq e => Tree e -> Tree e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree e -> Tree e -> Bool
$c/= :: forall e. Eq e => Tree e -> Tree e -> Bool
== :: Tree e -> Tree e -> Bool
$c== :: forall e. Eq e => Tree e -> Tree e -> Bool
Eq)

def :: Ord e => Tree e
def :: Tree e
def = Map e (Tree e) -> Tree e
forall e. Map e (Tree e) -> Tree e
Node Map e (Tree e)
forall k a. Map k a
M.empty

type DataStructure = (Tree T.Text, Tree T.Text)