module Hasura.RQL.Types.Endpoint.Trie
  ( -- * Types
    MultiMapPathTrie,
    MatchResult (..),
    PathComponent (..),

    -- * Path matching
    matchPath,
    ambiguousPaths,
    ambiguousPathsGrouped,
  )
where

import Data.Aeson (ToJSON, ToJSONKey)
import Data.HashMap.Strict qualified as HashMap
import Data.HashMap.Strict.Multi qualified as MM
import Data.Set qualified as S
import Data.Trie qualified as T
import Hasura.Prelude

-------------------------------------------------------------------------------
-- Types

-- | Trie from 'PathComponent's to 'MultiMap's
type MultiMapPathTrie a k v = T.Trie (PathComponent a) (MM.MultiMap k v)

-- | A component in a URL path: either a literal or a wildcard parameter
data PathComponent a
  = PathLiteral a
  | PathParam
  deriving stock (Int -> PathComponent a -> ShowS
[PathComponent a] -> ShowS
PathComponent a -> String
(Int -> PathComponent a -> ShowS)
-> (PathComponent a -> String)
-> ([PathComponent a] -> ShowS)
-> Show (PathComponent a)
forall a. Show a => Int -> PathComponent a -> ShowS
forall a. Show a => [PathComponent a] -> ShowS
forall a. Show a => PathComponent a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> PathComponent a -> ShowS
showsPrec :: Int -> PathComponent a -> ShowS
$cshow :: forall a. Show a => PathComponent a -> String
show :: PathComponent a -> String
$cshowList :: forall a. Show a => [PathComponent a] -> ShowS
showList :: [PathComponent a] -> ShowS
Show, PathComponent a -> PathComponent a -> Bool
(PathComponent a -> PathComponent a -> Bool)
-> (PathComponent a -> PathComponent a -> Bool)
-> Eq (PathComponent a)
forall a. Eq a => PathComponent a -> PathComponent a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => PathComponent a -> PathComponent a -> Bool
== :: PathComponent a -> PathComponent a -> Bool
$c/= :: forall a. Eq a => PathComponent a -> PathComponent a -> Bool
/= :: PathComponent a -> PathComponent a -> Bool
Eq, Eq (PathComponent a)
Eq (PathComponent a)
-> (PathComponent a -> PathComponent a -> Ordering)
-> (PathComponent a -> PathComponent a -> Bool)
-> (PathComponent a -> PathComponent a -> Bool)
-> (PathComponent a -> PathComponent a -> Bool)
-> (PathComponent a -> PathComponent a -> Bool)
-> (PathComponent a -> PathComponent a -> PathComponent a)
-> (PathComponent a -> PathComponent a -> PathComponent a)
-> Ord (PathComponent a)
PathComponent a -> PathComponent a -> Bool
PathComponent a -> PathComponent a -> Ordering
PathComponent a -> PathComponent a -> PathComponent a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (PathComponent a)
forall a. Ord a => PathComponent a -> PathComponent a -> Bool
forall a. Ord a => PathComponent a -> PathComponent a -> Ordering
forall a.
Ord a =>
PathComponent a -> PathComponent a -> PathComponent a
$ccompare :: forall a. Ord a => PathComponent a -> PathComponent a -> Ordering
compare :: PathComponent a -> PathComponent a -> Ordering
$c< :: forall a. Ord a => PathComponent a -> PathComponent a -> Bool
< :: PathComponent a -> PathComponent a -> Bool
$c<= :: forall a. Ord a => PathComponent a -> PathComponent a -> Bool
<= :: PathComponent a -> PathComponent a -> Bool
$c> :: forall a. Ord a => PathComponent a -> PathComponent a -> Bool
> :: PathComponent a -> PathComponent a -> Bool
$c>= :: forall a. Ord a => PathComponent a -> PathComponent a -> Bool
>= :: PathComponent a -> PathComponent a -> Bool
$cmax :: forall a.
Ord a =>
PathComponent a -> PathComponent a -> PathComponent a
max :: PathComponent a -> PathComponent a -> PathComponent a
$cmin :: forall a.
Ord a =>
PathComponent a -> PathComponent a -> PathComponent a
min :: PathComponent a -> PathComponent a -> PathComponent a
Ord, (forall x. PathComponent a -> Rep (PathComponent a) x)
-> (forall x. Rep (PathComponent a) x -> PathComponent a)
-> Generic (PathComponent a)
forall x. Rep (PathComponent a) x -> PathComponent a
forall x. PathComponent a -> Rep (PathComponent a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PathComponent a) x -> PathComponent a
forall a x. PathComponent a -> Rep (PathComponent a) x
$cfrom :: forall a x. PathComponent a -> Rep (PathComponent a) x
from :: forall x. PathComponent a -> Rep (PathComponent a) x
$cto :: forall a x. Rep (PathComponent a) x -> PathComponent a
to :: forall x. Rep (PathComponent a) x -> PathComponent a
Generic)

instance (ToJSON a) => ToJSON (PathComponent a)

instance (ToJSON a) => ToJSONKey (PathComponent a)

instance (Hashable a) => Hashable (PathComponent a)

-- | Result of matching a path @['PathComponent'] a@ and key @k@ in a 'MultiMapPathTrie'.
--
-- 'MatchResult' is a lattice where 'MatchNotFound' is the bottom element and
-- 'MatchAmbiguous' is the top element:
--
--               MatchAmbiguous
--             /               \
--   MatchFound v0 as0     MatchFound v1 as1
--             \               /
--        MatchMissingKey (ks0 <> ks1)
--             /               \
--  MatchMissingKey ks0     MatchMissingKey ks1
--             \               /
--               MatchNotFound
data MatchResult a k v
  = -- | Multiple results.
    MatchAmbiguous
  | -- | A single unambiguous result. Returns the value found and a list of
    -- parameter bindings.
    MatchFound v [a]
  | -- | A path was found, but not a key. Returns a list of keys found.
    MatchMissingKey (NonEmpty k)
  | -- | Path was not found in the 'MultiMapPathTrie'.
    MatchNotFound
  deriving stock (MatchResult a k v -> MatchResult a k v -> Bool
(MatchResult a k v -> MatchResult a k v -> Bool)
-> (MatchResult a k v -> MatchResult a k v -> Bool)
-> Eq (MatchResult a k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a k v.
(Eq v, Eq a, Eq k) =>
MatchResult a k v -> MatchResult a k v -> Bool
$c== :: forall a k v.
(Eq v, Eq a, Eq k) =>
MatchResult a k v -> MatchResult a k v -> Bool
== :: MatchResult a k v -> MatchResult a k v -> Bool
$c/= :: forall a k v.
(Eq v, Eq a, Eq k) =>
MatchResult a k v -> MatchResult a k v -> Bool
/= :: MatchResult a k v -> MatchResult a k v -> Bool
Eq, Int -> MatchResult a k v -> ShowS
[MatchResult a k v] -> ShowS
MatchResult a k v -> String
(Int -> MatchResult a k v -> ShowS)
-> (MatchResult a k v -> String)
-> ([MatchResult a k v] -> ShowS)
-> Show (MatchResult a k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a k v.
(Show v, Show a, Show k) =>
Int -> MatchResult a k v -> ShowS
forall a k v.
(Show v, Show a, Show k) =>
[MatchResult a k v] -> ShowS
forall a k v.
(Show v, Show a, Show k) =>
MatchResult a k v -> String
$cshowsPrec :: forall a k v.
(Show v, Show a, Show k) =>
Int -> MatchResult a k v -> ShowS
showsPrec :: Int -> MatchResult a k v -> ShowS
$cshow :: forall a k v.
(Show v, Show a, Show k) =>
MatchResult a k v -> String
show :: MatchResult a k v -> String
$cshowList :: forall a k v.
(Show v, Show a, Show k) =>
[MatchResult a k v] -> ShowS
showList :: [MatchResult a k v] -> ShowS
Show)

-- | Semigroup and Monoid instances implement join (i.e. least upper bound)
-- on the above lattice.
instance Semigroup (MatchResult a k v) where
  -- Ambiguous match with anything else is ambiguous
  MatchResult a k v
MatchAmbiguous <> :: MatchResult a k v -> MatchResult a k v -> MatchResult a k v
<> MatchResult a k v
_ = MatchResult a k v
forall a k v. MatchResult a k v
MatchAmbiguous
  MatchResult a k v
_ <> MatchResult a k v
MatchAmbiguous = MatchResult a k v
forall a k v. MatchResult a k v
MatchAmbiguous
  -- Two unambiguous matches is ambiguous
  MatchFound {} <> MatchFound {} = MatchResult a k v
forall a k v. MatchResult a k v
MatchAmbiguous
  -- Unambiguous match with missing key or not found is unambiguous
  m :: MatchResult a k v
m@MatchFound {} <> MatchResult a k v
_ = MatchResult a k v
m
  MatchResult a k v
_ <> m :: MatchResult a k v
m@MatchFound {} = MatchResult a k v
m
  -- Collect allowed keys
  MatchMissingKey NonEmpty k
ks <> MatchMissingKey NonEmpty k
ks' = NonEmpty k -> MatchResult a k v
forall a k v. NonEmpty k -> MatchResult a k v
MatchMissingKey (NonEmpty k -> MatchResult a k v)
-> NonEmpty k -> MatchResult a k v
forall a b. (a -> b) -> a -> b
$ NonEmpty k
ks NonEmpty k -> NonEmpty k -> NonEmpty k
forall a. Semigroup a => a -> a -> a
<> NonEmpty k
ks'
  -- Not found is the identity element
  MatchResult a k v
MatchNotFound <> MatchResult a k v
r = MatchResult a k v
r
  MatchResult a k v
r <> MatchResult a k v
MatchNotFound = MatchResult a k v
r

instance Monoid (MatchResult a k v) where
  mempty :: MatchResult a k v
mempty = MatchResult a k v
forall a k v. MatchResult a k v
MatchNotFound

-------------------------------------------------------------------------------
-- Matching paths

-- | Look up the value at a path.
-- @PathParam@ matches any path component.
-- Returns a list of pairs containing the value found and bindings for any @PathParam@s.
lookupPath :: (Hashable a) => [a] -> T.Trie (PathComponent a) v -> [(v, [a])]
lookupPath :: forall a v.
Hashable a =>
[a] -> Trie (PathComponent a) v -> [(v, [a])]
lookupPath [] Trie (PathComponent a) v
t = [(v
v, []) | v
v <- Maybe v -> [v]
forall a. Maybe a -> [a]
maybeToList (Trie (PathComponent a) v -> Maybe v
forall k v. Trie k v -> Maybe v
T.trieData Trie (PathComponent a) v
t)]
lookupPath (a
x : [a]
xs) Trie (PathComponent a) v
t = do
  (PathComponent ()
pc, Trie (PathComponent a) v
t') <- a
-> HashMap (PathComponent a) (Trie (PathComponent a) v)
-> [(PathComponent (), Trie (PathComponent a) v)]
forall a v.
Hashable a =>
a -> HashMap (PathComponent a) v -> [(PathComponent (), v)]
matchPathComponent a
x (HashMap (PathComponent a) (Trie (PathComponent a) v)
 -> [(PathComponent (), Trie (PathComponent a) v)])
-> HashMap (PathComponent a) (Trie (PathComponent a) v)
-> [(PathComponent (), Trie (PathComponent a) v)]
forall a b. (a -> b) -> a -> b
$ Trie (PathComponent a) v
-> HashMap (PathComponent a) (Trie (PathComponent a) v)
forall k v. Trie k v -> HashMap k (Trie k v)
T.trieMap Trie (PathComponent a) v
t
  (v, [a])
m <- [a] -> Trie (PathComponent a) v -> [(v, [a])]
forall a v.
Hashable a =>
[a] -> Trie (PathComponent a) v -> [(v, [a])]
lookupPath [a]
xs Trie (PathComponent a) v
t'
  (v, [a]) -> [(v, [a])]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((v, [a]) -> [(v, [a])]) -> (v, [a]) -> [(v, [a])]
forall a b. (a -> b) -> a -> b
$ case PathComponent ()
pc of
    PathLiteral {} -> (v, [a])
m
    PathComponent ()
PathParam -> (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ([a] -> [a]) -> (v, [a]) -> (v, [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (v, [a])
m
  where
    matchPathComponent ::
      (Hashable a) =>
      a ->
      HashMap.HashMap (PathComponent a) v ->
      [(PathComponent (), v)]
    matchPathComponent :: forall a v.
Hashable a =>
a -> HashMap (PathComponent a) v -> [(PathComponent (), v)]
matchPathComponent a
a HashMap (PathComponent a) v
m =
      [Maybe (PathComponent (), v)] -> [(PathComponent (), v)]
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [(() -> PathComponent ()
forall a. a -> PathComponent a
PathLiteral (),) (v -> (PathComponent (), v))
-> Maybe v -> Maybe (PathComponent (), v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PathComponent a -> HashMap (PathComponent a) v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (a -> PathComponent a
forall a. a -> PathComponent a
PathLiteral a
a) HashMap (PathComponent a) v
m, (PathComponent ()
forall a. PathComponent a
PathParam,) (v -> (PathComponent (), v))
-> Maybe v -> Maybe (PathComponent (), v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PathComponent a -> HashMap (PathComponent a) v -> Maybe v
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup PathComponent a
forall a. PathComponent a
PathParam HashMap (PathComponent a) v
m]

-- | Match a key @k@ and path @[a]@ against a @MultiMapPathTrie a k v@
matchPath :: (Hashable k, Hashable a) => k -> [a] -> MultiMapPathTrie a k v -> MatchResult a k v
matchPath :: forall k a v.
(Hashable k, Hashable a) =>
k -> [a] -> MultiMapPathTrie a k v -> MatchResult a k v
matchPath k
k [a]
path = ((MultiMap k v, [a]) -> MatchResult a k v)
-> [(MultiMap k v, [a])] -> MatchResult a k v
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (MultiMap k v, [a]) -> MatchResult a k v
toResult ([(MultiMap k v, [a])] -> MatchResult a k v)
-> (MultiMapPathTrie a k v -> [(MultiMap k v, [a])])
-> MultiMapPathTrie a k v
-> MatchResult a k v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> MultiMapPathTrie a k v -> [(MultiMap k v, [a])]
forall a v.
Hashable a =>
[a] -> Trie (PathComponent a) v -> [(v, [a])]
lookupPath [a]
path
  where
    toResult :: (MultiMap k v, [a]) -> MatchResult a k v
toResult (MultiMap k v
methodMap, [a]
paramMatches) =
      case Set v -> [v]
forall a. Set a -> [a]
S.toList (Set v -> [v]) -> Set v -> [v]
forall a b. (a -> b) -> a -> b
$ k -> MultiMap k v -> Set v
forall k v. Hashable k => k -> MultiMap k v -> Set v
MM.lookup k
k MultiMap k v
methodMap of
        [] -> MatchResult a k v
-> (NonEmpty k -> MatchResult a k v)
-> Maybe (NonEmpty k)
-> MatchResult a k v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MatchResult a k v
forall a k v. MatchResult a k v
MatchNotFound NonEmpty k -> MatchResult a k v
forall a k v. NonEmpty k -> MatchResult a k v
MatchMissingKey ([k] -> Maybe (NonEmpty k)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([k] -> Maybe (NonEmpty k)) -> [k] -> Maybe (NonEmpty k)
forall a b. (a -> b) -> a -> b
$ MultiMap k v -> [k]
forall k v. MultiMap k v -> [k]
MM.keys MultiMap k v
methodMap)
        [v
v] -> v -> [a] -> MatchResult a k v
forall a k v. v -> [a] -> MatchResult a k v
MatchFound v
v [a]
paramMatches
        [v]
_ -> MatchResult a k v
forall a k v. MatchResult a k v
MatchAmbiguous

-- | A version of ambiguousPaths that attempts to group all ambiguous paths that have overlapping endpoints
ambiguousPathsGrouped :: (Hashable a, Hashable k, Ord v, Ord a) => MultiMapPathTrie a k v -> [(S.Set [PathComponent a], S.Set v)]
ambiguousPathsGrouped :: forall a k v.
(Hashable a, Hashable k, Ord v, Ord a) =>
MultiMapPathTrie a k v -> [(Set [PathComponent a], Set v)]
ambiguousPathsGrouped = [(Set [PathComponent a], Set v)]
-> [(Set [PathComponent a], Set v)]
forall a v.
(Ord a, Ord v) =>
[(Set [PathComponent a], Set v)]
-> [(Set [PathComponent a], Set v)]
groupAmbiguousPaths ([(Set [PathComponent a], Set v)]
 -> [(Set [PathComponent a], Set v)])
-> (MultiMapPathTrie a k v -> [(Set [PathComponent a], Set v)])
-> MultiMapPathTrie a k v
-> [(Set [PathComponent a], Set v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([PathComponent a], Set v) -> (Set [PathComponent a], Set v))
-> [([PathComponent a], Set v)] -> [(Set [PathComponent a], Set v)]
forall a b. (a -> b) -> [a] -> [b]
map (([PathComponent a] -> Set [PathComponent a])
-> ([PathComponent a], Set v) -> (Set [PathComponent a], Set v)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [PathComponent a] -> Set [PathComponent a]
forall a. a -> Set a
S.singleton) ([([PathComponent a], Set v)] -> [(Set [PathComponent a], Set v)])
-> (MultiMapPathTrie a k v -> [([PathComponent a], Set v)])
-> MultiMapPathTrie a k v
-> [(Set [PathComponent a], Set v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiMapPathTrie a k v -> [([PathComponent a], Set v)]
forall a k v.
(Hashable a, Hashable k, Ord v) =>
MultiMapPathTrie a k v -> [([PathComponent a], Set v)]
ambiguousPaths

groupAmbiguousPaths :: (Ord a, Ord v) => [(S.Set [PathComponent a], S.Set v)] -> [(S.Set [PathComponent a], S.Set v)]
groupAmbiguousPaths :: forall a v.
(Ord a, Ord v) =>
[(Set [PathComponent a], Set v)]
-> [(Set [PathComponent a], Set v)]
groupAmbiguousPaths [] = []
groupAmbiguousPaths ((Set [PathComponent a], Set v)
x : [(Set [PathComponent a], Set v)]
xs) =
  if ((Bool, (Set [PathComponent a], Set v)) -> Bool)
-> [(Bool, (Set [PathComponent a], Set v))] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool, (Set [PathComponent a], Set v)) -> Bool
forall a b. (a, b) -> a
fst [(Bool, (Set [PathComponent a], Set v))]
added
    then [(Set [PathComponent a], Set v)]
-> [(Set [PathComponent a], Set v)]
forall a v.
(Ord a, Ord v) =>
[(Set [PathComponent a], Set v)]
-> [(Set [PathComponent a], Set v)]
groupAmbiguousPaths ([(Set [PathComponent a], Set v)]
 -> [(Set [PathComponent a], Set v)])
-> [(Set [PathComponent a], Set v)]
-> [(Set [PathComponent a], Set v)]
forall a b. (a -> b) -> a -> b
$ ((Bool, (Set [PathComponent a], Set v))
 -> (Set [PathComponent a], Set v))
-> [(Bool, (Set [PathComponent a], Set v))]
-> [(Set [PathComponent a], Set v)]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, (Set [PathComponent a], Set v))
-> (Set [PathComponent a], Set v)
forall a b. (a, b) -> b
snd [(Bool, (Set [PathComponent a], Set v))]
added
    else (Set [PathComponent a], Set v)
x (Set [PathComponent a], Set v)
-> [(Set [PathComponent a], Set v)]
-> [(Set [PathComponent a], Set v)]
forall a. a -> [a] -> [a]
: [(Set [PathComponent a], Set v)]
-> [(Set [PathComponent a], Set v)]
forall a v.
(Ord a, Ord v) =>
[(Set [PathComponent a], Set v)]
-> [(Set [PathComponent a], Set v)]
groupAmbiguousPaths [(Set [PathComponent a], Set v)]
xs
  where
    added :: [(Bool, (Set [PathComponent a], Set v))]
added = ((Set [PathComponent a], Set v)
 -> (Bool, (Set [PathComponent a], Set v)))
-> [(Set [PathComponent a], Set v)]
-> [(Bool, (Set [PathComponent a], Set v))]
forall a b. (a -> b) -> [a] -> [b]
map ((Set [PathComponent a], Set v)
-> (Set [PathComponent a], Set v)
-> (Bool, (Set [PathComponent a], Set v))
forall {a} {a}.
(Ord a, Ord a) =>
(Set a, Set a) -> (Set a, Set a) -> (Bool, (Set a, Set a))
add (Set [PathComponent a], Set v)
x) [(Set [PathComponent a], Set v)]
xs
    add :: (Set a, Set a) -> (Set a, Set a) -> (Bool, (Set a, Set a))
add (Set a
p1, Set a
v1) (Set a
p2, Set a
v2)
      | Set a -> Set a -> Bool
forall a. Ord a => Set a -> Set a -> Bool
S.disjoint Set a
v1 Set a
v2 = (Bool
False, (Set a
p2, Set a
v2))
      | Bool
otherwise = (Bool
True, (Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
p1 Set a
p2, Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
v1 Set a
v2))

-- | Detect and return all ambiguous paths in the @MultiMapPathTrie@
-- A path @p@ is ambiguous if @matchPath k p@ can return @MatchAmbiguous@ for some @k@.
ambiguousPaths :: (Hashable a, Hashable k, Ord v) => MultiMapPathTrie a k v -> [([PathComponent a], S.Set v)]
ambiguousPaths :: forall a k v.
(Hashable a, Hashable k, Ord v) =>
MultiMapPathTrie a k v -> [([PathComponent a], Set v)]
ambiguousPaths (T.Trie HashMap (PathComponent a) (Trie (PathComponent a) (MultiMap k v))
pathMap Maybe (MultiMap k v)
methodMap) =
  [([PathComponent a], Set v)]
thisNodeAmbiguousPaths [([PathComponent a], Set v)]
-> [([PathComponent a], Set v)] -> [([PathComponent a], Set v)]
forall a. [a] -> [a] -> [a]
++ [([PathComponent a], Set v)]
childNodesAmbiguousPaths
  where
    isAmbiguous :: Set a -> Bool
isAmbiguous Set a
e = Set a -> Int
forall a. Set a -> Int
S.size Set a
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
    ambiguous :: Set v
ambiguous = [Set v] -> Set v
forall a. Monoid a => [a] -> a
mconcat ([Set v] -> Set v) -> [Set v] -> Set v
forall a b. (a -> b) -> a -> b
$ (Set v -> Bool) -> [Set v] -> [Set v]
forall a. (a -> Bool) -> [a] -> [a]
filter Set v -> Bool
forall {a}. Set a -> Bool
isAmbiguous ([Set v] -> [Set v]) -> [Set v] -> [Set v]
forall a b. (a -> b) -> a -> b
$ [Set v]
-> (MultiMap k v -> [Set v]) -> Maybe (MultiMap k v) -> [Set v]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] MultiMap k v -> [Set v]
forall k v. MultiMap k v -> [Set v]
MM.elems Maybe (MultiMap k v)
methodMap
    thisNodeAmbiguousPaths :: [([PathComponent a], Set v)]
thisNodeAmbiguousPaths = Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Set v -> Bool
forall {a}. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Set v -> Bool) -> Set v -> Bool
forall a b. (a -> b) -> a -> b
$ Set v
ambiguous) [()]
-> [([PathComponent a], Set v)] -> [([PathComponent a], Set v)]
forall a b. [a] -> [b] -> [b]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [([], Set v
ambiguous)]
    childNodesAmbiguousPaths :: [([PathComponent a], Set v)]
childNodesAmbiguousPaths = (PathComponent a
 -> Trie (PathComponent a) (MultiMap k v)
 -> [([PathComponent a], Set v)])
-> (PathComponent a, Trie (PathComponent a) (MultiMap k v))
-> [([PathComponent a], Set v)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry PathComponent a
-> Trie (PathComponent a) (MultiMap k v)
-> [([PathComponent a], Set v)]
childNodeAmbiguousPaths ((PathComponent a, Trie (PathComponent a) (MultiMap k v))
 -> [([PathComponent a], Set v)])
-> [(PathComponent a, Trie (PathComponent a) (MultiMap k v))]
-> [([PathComponent a], Set v)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< HashMap (PathComponent a) (Trie (PathComponent a) (MultiMap k v))
-> [(PathComponent a, Trie (PathComponent a) (MultiMap k v))]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap (PathComponent a) (Trie (PathComponent a) (MultiMap k v))
pathMap
    childNodeAmbiguousPaths :: PathComponent a
-> Trie (PathComponent a) (MultiMap k v)
-> [([PathComponent a], Set v)]
childNodeAmbiguousPaths PathComponent a
pc Trie (PathComponent a) (MultiMap k v)
t = ([PathComponent a] -> [PathComponent a])
-> ([PathComponent a], Set v) -> ([PathComponent a], Set v)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (PathComponent a
pc PathComponent a -> [PathComponent a] -> [PathComponent a]
forall a. a -> [a] -> [a]
:) (([PathComponent a], Set v) -> ([PathComponent a], Set v))
-> [([PathComponent a], Set v)] -> [([PathComponent a], Set v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Trie (PathComponent a) (MultiMap k v)
-> [([PathComponent a], Set v)]
forall a k v.
(Hashable a, Hashable k, Ord v) =>
MultiMapPathTrie a k v -> [([PathComponent a], Set v)]
ambiguousPaths (Trie (PathComponent a) (MultiMap k v)
-> Trie (PathComponent a) (MultiMap k v)
mergeWildcardTrie Trie (PathComponent a) (MultiMap k v)
t)
    wildcardTrie :: Maybe (Trie (PathComponent a) (MultiMap k v))
wildcardTrie = PathComponent a
-> HashMap
     (PathComponent a) (Trie (PathComponent a) (MultiMap k v))
-> Maybe (Trie (PathComponent a) (MultiMap k v))
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup PathComponent a
forall a. PathComponent a
PathParam HashMap (PathComponent a) (Trie (PathComponent a) (MultiMap k v))
pathMap
    mergeWildcardTrie :: Trie (PathComponent a) (MultiMap k v)
-> Trie (PathComponent a) (MultiMap k v)
mergeWildcardTrie = (Trie (PathComponent a) (MultiMap k v)
 -> Trie (PathComponent a) (MultiMap k v))
-> (Trie (PathComponent a) (MultiMap k v)
    -> Trie (PathComponent a) (MultiMap k v)
    -> Trie (PathComponent a) (MultiMap k v))
-> Maybe (Trie (PathComponent a) (MultiMap k v))
-> Trie (PathComponent a) (MultiMap k v)
-> Trie (PathComponent a) (MultiMap k v)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Trie (PathComponent a) (MultiMap k v)
-> Trie (PathComponent a) (MultiMap k v)
forall a. a -> a
id Trie (PathComponent a) (MultiMap k v)
-> Trie (PathComponent a) (MultiMap k v)
-> Trie (PathComponent a) (MultiMap k v)
forall a. Semigroup a => a -> a -> a
(<>) Maybe (Trie (PathComponent a) (MultiMap k v))
wildcardTrie