module Mig.Core.Api.NormalForm.TreeApi (
TreeApi (..),
CaptureCase (..),
getPath,
toTreeApi,
) where
import Data.List qualified as List
import Data.List.Extra qualified as List
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (isNothing, mapMaybe)
import Data.Text (Text)
import Data.Text qualified as Text
import Mig.Core.Api (Api (..), Path (..), PathItem (..))
type CaptureMap = Map Text Text
data TreeApi a
= WithStaticPath [Text] (TreeApi a)
| WithCapturePath [Text] (TreeApi a)
| SwitchApi (Maybe a) (Map Text (TreeApi a)) (Maybe (CaptureCase a))
deriving (TreeApi a -> TreeApi a -> Bool
forall a. Eq a => TreeApi a -> TreeApi a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TreeApi a -> TreeApi a -> Bool
$c/= :: forall a. Eq a => TreeApi a -> TreeApi a -> Bool
== :: TreeApi a -> TreeApi a -> Bool
$c== :: forall a. Eq a => TreeApi a -> TreeApi a -> Bool
Eq, Int -> TreeApi a -> ShowS
forall a. Show a => Int -> TreeApi a -> ShowS
forall a. Show a => [TreeApi a] -> ShowS
forall a. Show a => TreeApi a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TreeApi a] -> ShowS
$cshowList :: forall a. Show a => [TreeApi a] -> ShowS
show :: TreeApi a -> String
$cshow :: forall a. Show a => TreeApi a -> String
showsPrec :: Int -> TreeApi a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> TreeApi a -> ShowS
Show, forall a b. a -> TreeApi b -> TreeApi a
forall a b. (a -> b) -> TreeApi a -> TreeApi b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> TreeApi b -> TreeApi a
$c<$ :: forall a b. a -> TreeApi b -> TreeApi a
fmap :: forall a b. (a -> b) -> TreeApi a -> TreeApi b
$cfmap :: forall a b. (a -> b) -> TreeApi a -> TreeApi b
Functor)
data CaptureCase a = CaptureCase
{ forall a. CaptureCase a -> Text
name :: Text
, forall a. CaptureCase a -> TreeApi a
api :: TreeApi a
}
deriving (CaptureCase a -> CaptureCase a -> Bool
forall a. Eq a => CaptureCase a -> CaptureCase a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CaptureCase a -> CaptureCase a -> Bool
$c/= :: forall a. Eq a => CaptureCase a -> CaptureCase a -> Bool
== :: CaptureCase a -> CaptureCase a -> Bool
$c== :: forall a. Eq a => CaptureCase a -> CaptureCase a -> Bool
Eq, Int -> CaptureCase a -> ShowS
forall a. Show a => Int -> CaptureCase a -> ShowS
forall a. Show a => [CaptureCase a] -> ShowS
forall a. Show a => CaptureCase a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CaptureCase a] -> ShowS
$cshowList :: forall a. Show a => [CaptureCase a] -> ShowS
show :: CaptureCase a -> String
$cshow :: forall a. Show a => CaptureCase a -> String
showsPrec :: Int -> CaptureCase a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CaptureCase a -> ShowS
Show, forall a b. a -> CaptureCase b -> CaptureCase a
forall a b. (a -> b) -> CaptureCase a -> CaptureCase b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CaptureCase b -> CaptureCase a
$c<$ :: forall a b. a -> CaptureCase b -> CaptureCase a
fmap :: forall a b. (a -> b) -> CaptureCase a -> CaptureCase b
$cfmap :: forall a b. (a -> b) -> CaptureCase a -> CaptureCase b
Functor)
getPath :: [Text] -> TreeApi a -> Maybe (a, CaptureMap)
getPath :: forall a. [Text] -> TreeApi a -> Maybe (a, CaptureMap)
getPath [Text]
mainPath = forall a.
CaptureMap -> [Text] -> TreeApi a -> Maybe (a, CaptureMap)
go forall a. Monoid a => a
mempty (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null) [Text]
mainPath)
where
go :: CaptureMap -> [Text] -> TreeApi a -> Maybe (a, CaptureMap)
go :: forall a.
CaptureMap -> [Text] -> TreeApi a -> Maybe (a, CaptureMap)
go !CaptureMap
captures ![Text]
path !TreeApi a
api =
case [Text]
path of
[] ->
case TreeApi a
api of
SwitchApi (Just a
result) Map Text (TreeApi a)
_ Maybe (CaptureCase a)
_ -> forall a. a -> Maybe a
Just (a
result, CaptureMap
captures)
TreeApi a
_ -> forall a. Maybe a
Nothing
Text
headPath : [Text]
tailPath ->
case TreeApi a
api of
WithStaticPath [Text]
static TreeApi a
subApi -> forall {a}.
CaptureMap
-> [Text] -> [Text] -> TreeApi a -> Maybe (a, CaptureMap)
onStaticPath CaptureMap
captures (Text
headPath forall a. a -> [a] -> [a]
: [Text]
tailPath) [Text]
static TreeApi a
subApi
WithCapturePath [Text]
names TreeApi a
subApi -> forall {a}.
CaptureMap
-> [Text] -> [Text] -> TreeApi a -> Maybe (a, CaptureMap)
onCapturePath CaptureMap
captures (Text
headPath forall a. a -> [a] -> [a]
: [Text]
tailPath) [Text]
names TreeApi a
subApi
SwitchApi Maybe a
_ Map Text (TreeApi a)
alternatives Maybe (CaptureCase a)
mCapture -> forall {r} {a}.
(HasField "name" r Text, HasField "api" r (TreeApi a)) =>
CaptureMap
-> Text
-> [Text]
-> Map Text (TreeApi a)
-> Maybe r
-> Maybe (a, CaptureMap)
onSwitch CaptureMap
captures Text
headPath [Text]
tailPath Map Text (TreeApi a)
alternatives Maybe (CaptureCase a)
mCapture
onStaticPath :: CaptureMap
-> [Text] -> [Text] -> TreeApi a -> Maybe (a, CaptureMap)
onStaticPath CaptureMap
captures [Text]
pathQuery [Text]
staticPath TreeApi a
subApi = do
[Text]
rest <- forall a. Eq a => [a] -> [a] -> Maybe [a]
checkPrefix [Text]
staticPath [Text]
pathQuery
forall a.
CaptureMap -> [Text] -> TreeApi a -> Maybe (a, CaptureMap)
go CaptureMap
captures [Text]
rest TreeApi a
subApi
onCapturePath :: CaptureMap
-> [Text] -> [Text] -> TreeApi a -> Maybe (a, CaptureMap)
onCapturePath CaptureMap
captures [Text]
pathQuery [Text]
names TreeApi a
subApi = do
(CaptureMap
nextCaptures, [Text]
nextPath) <- CaptureMap -> [Text] -> [Text] -> Maybe (CaptureMap, [Text])
accumCapture CaptureMap
captures [Text]
names [Text]
pathQuery
forall a.
CaptureMap -> [Text] -> TreeApi a -> Maybe (a, CaptureMap)
go CaptureMap
nextCaptures [Text]
nextPath TreeApi a
subApi
onSwitch :: CaptureMap
-> Text
-> [Text]
-> Map Text (TreeApi a)
-> Maybe r
-> Maybe (a, CaptureMap)
onSwitch CaptureMap
captures Text
headPath [Text]
tailPath Map Text (TreeApi a)
alternatives Maybe r
mCapture =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
headPath Map Text (TreeApi a)
alternatives of
Just TreeApi a
subApi -> forall a.
CaptureMap -> [Text] -> TreeApi a -> Maybe (a, CaptureMap)
go CaptureMap
captures [Text]
tailPath TreeApi a
subApi
Maybe (TreeApi a)
Nothing -> do
r
captureCase <- Maybe r
mCapture
forall a.
CaptureMap -> [Text] -> TreeApi a -> Maybe (a, CaptureMap)
go (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert r
captureCase.name Text
headPath CaptureMap
captures) [Text]
tailPath r
captureCase.api
checkPrefix :: (Eq a) => [a] -> [a] -> Maybe [a]
checkPrefix :: forall a. Eq a => [a] -> [a] -> Maybe [a]
checkPrefix (a
a : [a]
as) (a
b : [a]
bs)
| a
a forall a. Eq a => a -> a -> Bool
== a
b = forall a. Eq a => [a] -> [a] -> Maybe [a]
checkPrefix [a]
as [a]
bs
| Bool
otherwise = forall a. Maybe a
Nothing
checkPrefix [] [a]
b = forall a. a -> Maybe a
Just [a]
b
checkPrefix [a]
_ [a]
_ = forall a. Maybe a
Nothing
accumCapture :: CaptureMap -> [Text] -> [Text] -> Maybe (CaptureMap, [Text])
accumCapture :: CaptureMap -> [Text] -> [Text] -> Maybe (CaptureMap, [Text])
accumCapture !CaptureMap
captures ![Text]
names ![Text]
path =
case [Text]
names of
[] -> forall a. a -> Maybe a
Just (CaptureMap
captures, [Text]
path)
Text
name : [Text]
rest ->
case [Text]
path of
Text
pathHead : [Text]
pathTail -> CaptureMap -> [Text] -> [Text] -> Maybe (CaptureMap, [Text])
accumCapture (forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name Text
pathHead CaptureMap
captures) [Text]
rest [Text]
pathTail
[] -> forall a. Maybe a
Nothing
toTreeApi :: Api a -> TreeApi a
toTreeApi :: forall a. Api a -> TreeApi a
toTreeApi =
forall a. TreeApi a -> TreeApi a
joinPaths forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Api a
Empty -> forall a.
Maybe a
-> Map Text (TreeApi a) -> Maybe (CaptureCase a) -> TreeApi a
SwitchApi forall a. Maybe a
Nothing forall a. Monoid a => a
mempty forall a. Maybe a
Nothing
WithPath Path
path Api a
subApi -> case Path -> Maybe PathPrefix
fromPathPrefix Path
path of
Maybe PathPrefix
Nothing -> forall a. Api a -> TreeApi a
toTreeApi Api a
subApi
Just PathPrefix
prefix -> case PathPrefix
prefix of
StaticPrefix [Text]
ps Path
rest -> forall a. [Text] -> TreeApi a -> TreeApi a
WithStaticPath [Text]
ps (forall a. Api a -> TreeApi a
toTreeApi forall a b. (a -> b) -> a -> b
$ forall a. Path -> Api a -> Api a
WithPath Path
rest Api a
subApi)
CapturePrefix [Text]
ps Path
rest -> forall a. [Text] -> TreeApi a -> TreeApi a
WithCapturePath [Text]
ps (forall a. Api a -> TreeApi a
toTreeApi forall a b. (a -> b) -> a -> b
$ forall a. Path -> Api a -> Api a
WithPath Path
rest Api a
subApi)
HandleRoute a
a -> forall a.
Maybe a
-> Map Text (TreeApi a) -> Maybe (CaptureCase a) -> TreeApi a
SwitchApi (forall a. a -> Maybe a
Just a
a) forall a. Monoid a => a
mempty forall a. Maybe a
Nothing
Append Api a
a Api a
b -> forall a. Alts a -> TreeApi a
fromAlts forall a b. (a -> b) -> a -> b
$ forall a. [AppendItem a] -> Alts a
orderAppends (forall a. Api a -> [AppendItem a]
collectAppends Api a
a forall a. Semigroup a => a -> a -> a
<> forall a. Api a -> [AppendItem a]
collectAppends Api a
b)
joinPaths :: TreeApi a -> TreeApi a
joinPaths :: forall a. TreeApi a -> TreeApi a
joinPaths = \case
SwitchApi Maybe a
mRoute Map Text (TreeApi a)
alts Maybe (CaptureCase a)
mCapture -> forall a.
Maybe a
-> Map Text (TreeApi a) -> Maybe (CaptureCase a) -> TreeApi a
SwitchApi Maybe a
mRoute (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. TreeApi a -> TreeApi a
joinPaths Map Text (TreeApi a)
alts) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. CaptureCase a -> CaptureCase a
joinCapturePaths Maybe (CaptureCase a)
mCapture)
WithStaticPath [Text]
pathA (WithStaticPath [Text]
pathB TreeApi a
subApi) -> forall a. TreeApi a -> TreeApi a
joinPaths (forall a. [Text] -> TreeApi a -> TreeApi a
WithStaticPath ([Text]
pathA forall a. [a] -> [a] -> [a]
++ [Text]
pathB) TreeApi a
subApi)
WithCapturePath [Text]
namesA (WithCapturePath [Text]
namesB TreeApi a
subApi) -> forall a. TreeApi a -> TreeApi a
joinPaths (forall a. [Text] -> TreeApi a -> TreeApi a
WithCapturePath ([Text]
namesA forall a. [a] -> [a] -> [a]
++ [Text]
namesB) TreeApi a
subApi)
WithStaticPath [Text]
path TreeApi a
subApi -> forall a. [Text] -> TreeApi a -> TreeApi a
WithStaticPath [Text]
path (forall a. TreeApi a -> TreeApi a
joinPaths TreeApi a
subApi)
WithCapturePath [Text]
names TreeApi a
subApi -> forall a. [Text] -> TreeApi a -> TreeApi a
WithCapturePath [Text]
names (forall a. TreeApi a -> TreeApi a
joinPaths TreeApi a
subApi)
where
joinCapturePaths :: CaptureCase a -> CaptureCase a
joinCapturePaths CaptureCase a
x = CaptureCase a
x{$sel:api:CaptureCase :: TreeApi a
api = forall a. TreeApi a -> TreeApi a
joinPaths CaptureCase a
x.api}
data Alts a = Alts
{ forall a. Alts a -> [(Text, Api a)]
appends :: [(Text, Api a)]
, forall a. Alts a -> Maybe (Text, Api a)
capture :: Maybe (Text, Api a)
, forall a. Alts a -> Maybe a
route :: Maybe a
}
data AppendItem a
= StaticAppend Text (Api a)
| RouteAppend a
| CaptureAppend Text (Api a)
collectAppends :: Api a -> [AppendItem a]
collectAppends :: forall a. Api a -> [AppendItem a]
collectAppends = \case
Api a
Empty -> []
HandleRoute a
a -> [forall a. a -> AppendItem a
RouteAppend a
a]
Append Api a
a Api a
b -> forall a. Api a -> [AppendItem a]
collectAppends Api a
a forall a. Semigroup a => a -> a -> a
<> forall a. Api a -> [AppendItem a]
collectAppends Api a
b
WithPath (Path [PathItem]
items) Api a
subApi -> case [PathItem]
items of
[] -> forall a. Api a -> [AppendItem a]
collectAppends Api a
subApi
StaticPath Text
item : [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> Api a -> AppendItem a
StaticAppend Text
item Api a
subApi
StaticPath Text
item : [PathItem]
rest -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> Api a -> AppendItem a
StaticAppend Text
item (forall a. Path -> Api a -> Api a
WithPath ([PathItem] -> Path
Path [PathItem]
rest) Api a
subApi)
CapturePath Text
item : [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> Api a -> AppendItem a
CaptureAppend Text
item Api a
subApi
CapturePath Text
item : [PathItem]
rest -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> Api a -> AppendItem a
CaptureAppend Text
item (forall a. Path -> Api a -> Api a
WithPath ([PathItem] -> Path
Path [PathItem]
rest) Api a
subApi)
orderAppends :: [AppendItem a] -> Alts a
orderAppends :: forall a. [AppendItem a] -> Alts a
orderAppends [AppendItem a]
items =
Alts
{ $sel:appends:Alts :: [(Text, Api a)]
appends = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. AppendItem a -> Maybe (Text, Api a)
toAppend [AppendItem a]
items
, $sel:capture:Alts :: Maybe (Text, Api a)
capture = forall a b. (a -> Maybe b) -> [a] -> Maybe b
List.firstJust forall {a}. AppendItem a -> Maybe (Text, Api a)
toCapture [AppendItem a]
items
, $sel:route:Alts :: Maybe a
route = forall a b. (a -> Maybe b) -> [a] -> Maybe b
List.firstJust forall {a}. AppendItem a -> Maybe a
toRoute [AppendItem a]
items
}
where
toAppend :: AppendItem a -> Maybe (Text, Api a)
toAppend = \case
StaticAppend Text
name Api a
api -> forall a. a -> Maybe a
Just (Text
name, Api a
api)
AppendItem a
_ -> forall a. Maybe a
Nothing
toCapture :: AppendItem a -> Maybe (Text, Api a)
toCapture = \case
CaptureAppend Text
name Api a
api -> forall a. a -> Maybe a
Just (Text
name, Api a
api)
AppendItem a
_ -> forall a. Maybe a
Nothing
toRoute :: AppendItem a -> Maybe a
toRoute = \case
RouteAppend a
route -> forall a. a -> Maybe a
Just a
route
AppendItem a
_ -> forall a. Maybe a
Nothing
fromAlts :: Alts a -> TreeApi a
fromAlts :: forall a. Alts a -> TreeApi a
fromAlts Alts a
alts =
case Maybe (Text, Api a)
getStaticSingleton of
Just (Text
path, Api a
subApi) -> forall a. [Text] -> TreeApi a -> TreeApi a
WithStaticPath [Text
path] (forall a. Api a -> TreeApi a
toTreeApi Api a
subApi)
Maybe (Text, Api a)
Nothing ->
case Maybe (Text, Api a)
getCaptureSingleton of
Just (Text
names, Api a
subApi) -> forall a. [Text] -> TreeApi a -> TreeApi a
WithCapturePath [Text
names] (forall a. Api a -> TreeApi a
toTreeApi Api a
subApi)
Maybe (Text, Api a)
Nothing -> forall a.
Maybe a
-> Map Text (TreeApi a) -> Maybe (CaptureCase a) -> TreeApi a
SwitchApi Alts a
alts.route (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Api a -> TreeApi a
toTreeApi forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList Alts a
alts.appends) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. (Text, Api a) -> CaptureCase a
toCaptureCase Alts a
alts.capture)
where
toCaptureCase :: (Text, Api a) -> CaptureCase a
toCaptureCase (Text
name, Api a
api) = forall a. Text -> TreeApi a -> CaptureCase a
CaptureCase Text
name (forall a. Api a -> TreeApi a
toTreeApi Api a
api)
getStaticSingleton :: Maybe (Text, Api a)
getStaticSingleton =
case Alts a
alts.appends of
[(Text
path, Api a
subApi)] | forall a. Maybe a -> Bool
isNothing Alts a
alts.route Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Alts a
alts.capture -> forall a. a -> Maybe a
Just (Text
path, Api a
subApi)
[(Text, Api a)]
_ -> forall a. Maybe a
Nothing
getCaptureSingleton :: Maybe (Text, Api a)
getCaptureSingleton =
case Alts a
alts.capture of
Just (Text
name, Api a
subApi) | forall a. Maybe a -> Bool
isNothing Alts a
alts.route Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null Alts a
alts.appends -> forall a. a -> Maybe a
Just (Text
name, Api a
subApi)
Maybe (Text, Api a)
_ -> forall a. Maybe a
Nothing
data PathPrefix
= StaticPrefix [Text] Path
| CapturePrefix [Text] Path
fromPathPrefix :: Path -> Maybe PathPrefix
fromPathPrefix :: Path -> Maybe PathPrefix
fromPathPrefix (Path [PathItem]
items) = case [PathItem]
items of
[] -> forall a. Maybe a
Nothing
StaticPath Text
item : [PathItem]
rest -> forall a. a -> Maybe a
Just ([Text] -> [PathItem] -> PathPrefix
accumStatics [Text
item] [PathItem]
rest)
CapturePath Text
item : [PathItem]
rest -> forall a. a -> Maybe a
Just ([Text] -> [PathItem] -> PathPrefix
accumCaptures [Text
item] [PathItem]
rest)
where
accumStatics :: [Text] -> [PathItem] -> PathPrefix
accumStatics [Text]
res [PathItem]
rest =
case [PathItem]
rest of
StaticPath Text
item : [PathItem]
nextRest -> [Text] -> [PathItem] -> PathPrefix
accumStatics (Text
item forall a. a -> [a] -> [a]
: [Text]
res) [PathItem]
nextRest
[PathItem]
_ -> [Text] -> Path -> PathPrefix
StaticPrefix (forall a. [a] -> [a]
List.reverse [Text]
res) ([PathItem] -> Path
Path [PathItem]
rest)
accumCaptures :: [Text] -> [PathItem] -> PathPrefix
accumCaptures [Text]
res [PathItem]
rest =
case [PathItem]
rest of
CapturePath Text
item : [PathItem]
nextRest -> [Text] -> [PathItem] -> PathPrefix
accumCaptures (Text
item forall a. a -> [a] -> [a]
: [Text]
res) [PathItem]
nextRest
[PathItem]
_ -> [Text] -> Path -> PathPrefix
CapturePrefix (forall a. [a] -> [a]
List.reverse [Text]
res) ([PathItem] -> Path
Path [PathItem]
rest)