module Mig.Core.Api (
Api (..),
Path (..),
ApiNormal (..),
toNormalApi,
fromNormalApi,
PathItem (..),
getPath,
CaptureMap,
flatApi,
fromFlatApi,
MethodMap,
OutputMediaMap (..),
InputMediaMap (..),
MediaMap (..),
) where
import Data.ByteString (ByteString)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.String
import Data.Text (Text)
import Data.Text qualified as Text
import Mig.Core.Class.Route qualified as Route
import Mig.Core.Types (RouteInfo (..), RouteOutput (..), getInputType)
import Network.HTTP.Media (mapAcceptMedia, mapContentMedia)
import Network.HTTP.Media.MediaType (MediaType)
import Network.HTTP.Types.Method
import System.FilePath
import Web.HttpApiData
data Api a
=
Append (Api a) (Api a)
|
Empty
|
WithPath Path (Api a)
|
HandleRoute a
deriving (forall a b. a -> Api b -> Api a
forall a b. (a -> b) -> Api a -> Api 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 -> Api b -> Api a
$c<$ :: forall a b. a -> Api b -> Api a
fmap :: forall a b. (a -> b) -> Api a -> Api b
$cfmap :: forall a b. (a -> b) -> Api a -> Api b
Functor, forall a. Eq a => a -> Api a -> Bool
forall a. Num a => Api a -> a
forall a. Ord a => Api a -> a
forall m. Monoid m => Api m -> m
forall a. Api a -> Bool
forall a. Api a -> Int
forall a. Api a -> [a]
forall a. (a -> a -> a) -> Api a -> a
forall m a. Monoid m => (a -> m) -> Api a -> m
forall b a. (b -> a -> b) -> b -> Api a -> b
forall a b. (a -> b -> b) -> b -> Api a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Api a -> a
$cproduct :: forall a. Num a => Api a -> a
sum :: forall a. Num a => Api a -> a
$csum :: forall a. Num a => Api a -> a
minimum :: forall a. Ord a => Api a -> a
$cminimum :: forall a. Ord a => Api a -> a
maximum :: forall a. Ord a => Api a -> a
$cmaximum :: forall a. Ord a => Api a -> a
elem :: forall a. Eq a => a -> Api a -> Bool
$celem :: forall a. Eq a => a -> Api a -> Bool
length :: forall a. Api a -> Int
$clength :: forall a. Api a -> Int
null :: forall a. Api a -> Bool
$cnull :: forall a. Api a -> Bool
toList :: forall a. Api a -> [a]
$ctoList :: forall a. Api a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Api a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Api a -> a
foldr1 :: forall a. (a -> a -> a) -> Api a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Api a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Api a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Api a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Api a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Api a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Api a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Api a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Api a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Api a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Api a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Api a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Api a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Api a -> m
fold :: forall m. Monoid m => Api m -> m
$cfold :: forall m. Monoid m => Api m -> m
Foldable, Functor Api
Foldable Api
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Api (m a) -> m (Api a)
forall (f :: * -> *) a. Applicative f => Api (f a) -> f (Api a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Api a -> m (Api b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Api a -> f (Api b)
sequence :: forall (m :: * -> *) a. Monad m => Api (m a) -> m (Api a)
$csequence :: forall (m :: * -> *) a. Monad m => Api (m a) -> m (Api a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Api a -> m (Api b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Api a -> m (Api b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Api (f a) -> f (Api a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Api (f a) -> f (Api a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Api a -> f (Api b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Api a -> f (Api b)
Traversable, Int -> Api a -> ShowS
forall a. Show a => Int -> Api a -> ShowS
forall a. Show a => [Api a] -> ShowS
forall a. Show a => Api a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Api a] -> ShowS
$cshowList :: forall a. Show a => [Api a] -> ShowS
show :: Api a -> String
$cshow :: forall a. Show a => Api a -> String
showsPrec :: Int -> Api a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Api a -> ShowS
Show, Api a -> Api a -> Bool
forall a. Eq a => Api a -> Api a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Api a -> Api a -> Bool
$c/= :: forall a. Eq a => Api a -> Api a -> Bool
== :: Api a -> Api a -> Bool
$c== :: forall a. Eq a => Api a -> Api a -> Bool
Eq)
instance Monoid (Api a) where
mempty :: Api a
mempty = forall a. Api a
Empty
instance Semigroup (Api a) where
<> :: Api a -> Api a -> Api a
(<>) = forall a. Api a -> Api a -> Api a
Append
filterApi :: (a -> Bool) -> Api a -> Api a
filterApi :: forall a. (a -> Bool) -> Api a -> Api a
filterApi a -> Bool
check = \case
HandleRoute a
a -> if a -> Bool
check a
a then forall a. a -> Api a
HandleRoute a
a else forall a. Api a
Empty
Append Api a
a Api a
b ->
case Api a -> Api a
rec Api a
a of
Api a
Empty -> Api a -> Api a
rec Api a
b
Api a
otherA ->
case Api a -> Api a
rec Api a
b of
Api a
Empty -> Api a
otherA
Api a
otherB -> forall a. Api a -> Api a -> Api a
Append Api a
otherA Api a
otherB
Api a
Empty -> forall a. Api a
Empty
WithPath Path
path Api a
a -> case Api a -> Api a
rec Api a
a of
Api a
Empty -> forall a. Api a
Empty
Api a
other -> forall a. Path -> Api a -> Api a
WithPath Path
path Api a
other
where
rec :: Api a -> Api a
rec = forall a. (a -> Bool) -> Api a -> Api a
filterApi a -> Bool
check
toNormalApi :: forall m. Api (Route.Route m) -> ApiNormal (Api (Route.Route m))
toNormalApi :: forall (m :: * -> *). Api (Route m) -> ApiNormal (Api (Route m))
toNormalApi Api (Route m)
api = forall a.
MethodMap (OutputMediaMap (InputMediaMap a)) -> ApiNormal a
ApiNormal forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Api (Route m) -> InputMediaMap (Api (Route m))
toInputMediaMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. Api (Route m) -> OutputMediaMap (Api (Route m))
toOutputMediaMap) (Api (Route m) -> MethodMap (Api (Route m))
toMethodMap Api (Route m)
api)
where
filterEmpty :: Map key (Api val) -> Map key (Api val)
filterEmpty :: forall key val. Map key (Api val) -> Map key (Api val)
filterEmpty = forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter forall a b. (a -> b) -> a -> b
$ \case
Api val
Empty -> Bool
False
Api val
_ -> Bool
True
toMethodMap :: Api (Route.Route m) -> MethodMap (Api (Route.Route m))
toMethodMap :: Api (Route m) -> MethodMap (Api (Route m))
toMethodMap Api (Route m)
a =
forall key val. Map key (Api val) -> Map key (Api val)
filterEmpty forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
( \Method
m ->
(Method
m, forall a. (a -> Bool) -> Api a -> Api a
filterApi (\Route m
route -> Route m
route.info.method forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Method
m) Api (Route m)
a)
)
[Method]
methods
where
methods :: [Method]
methods = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Route m
route -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall (f :: * -> *) a. Applicative f => a -> f a
pure Route m
route.info.method) Api (Route m)
a
toInputMediaMap :: Api (Route.Route m) -> InputMediaMap (Api (Route.Route m))
toInputMediaMap :: Api (Route m) -> InputMediaMap (Api (Route m))
toInputMediaMap = forall a. MediaMap a -> InputMediaMap a
InputMediaMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RouteInfo -> Maybe MediaType)
-> Api (Route m) -> MediaMap (Api (Route m))
toMediaMapBy RouteInfo -> Maybe MediaType
getInputType
toOutputMediaMap :: Api (Route.Route m) -> OutputMediaMap (Api (Route.Route m))
toOutputMediaMap :: Api (Route m) -> OutputMediaMap (Api (Route m))
toOutputMediaMap = forall a. MediaMap a -> OutputMediaMap a
OutputMediaMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RouteInfo -> Maybe MediaType)
-> Api (Route m) -> MediaMap (Api (Route m))
toMediaMapBy (\RouteInfo
routeInfo -> forall a. a -> Maybe a
Just RouteInfo
routeInfo.output.media)
toMediaMapBy :: (RouteInfo -> Maybe MediaType) -> Api (Route.Route m) -> MediaMap (Api (Route.Route m))
toMediaMapBy :: (RouteInfo -> Maybe MediaType)
-> Api (Route m) -> MediaMap (Api (Route m))
toMediaMapBy RouteInfo -> Maybe MediaType
getMedia Api (Route m)
a =
forall a. [(MediaType, a)] -> a -> MediaMap a
MediaMap (forall {b}. [(MediaType, b)] -> [(MediaType, b)]
filterAnyCases forall a b. (a -> b) -> a -> b
$ MediaType -> (MediaType, Api (Route m))
toMediaApi forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MediaType]
medias) Api (Route m)
a
where
medias :: [MediaType]
medias = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Route m
route -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Set a
Set.empty forall a. a -> Set a
Set.singleton (RouteInfo -> Maybe MediaType
getMedia Route m
route.info)) Api (Route m)
a
toMediaApi :: MediaType -> (MediaType, Api (Route m))
toMediaApi MediaType
media = (MediaType
media, forall a. (a -> Bool) -> Api a -> Api a
filterApi (\Route m
route -> RouteInfo -> Maybe MediaType
getMedia Route m
route.info forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just MediaType
media) Api (Route m)
a)
filterAnyCases :: [(MediaType, b)] -> [(MediaType, b)]
filterAnyCases = forall a. (a -> Bool) -> [a] -> [a]
filter ((MediaType
"*/*" /=) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
fromNormalApi :: Method -> ByteString -> ByteString -> ApiNormal a -> Maybe a
fromNormalApi :: forall a. Method -> Method -> Method -> ApiNormal a -> Maybe a
fromNormalApi Method
method Method
outputAccept Method
inputContentType (ApiNormal MethodMap (OutputMediaMap (InputMediaMap a))
methodMap) = do
OutputMediaMap MediaMap (InputMediaMap a)
outputMediaMap <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Method
method MethodMap (OutputMediaMap (InputMediaMap a))
methodMap
InputMediaMap MediaMap a
inputMediaMap <- forall a.
([(MediaType, a)] -> Method -> Maybe a)
-> MediaMap a -> Method -> Maybe a
lookupMediaMapBy forall b. [(MediaType, b)] -> Method -> Maybe b
mapAcceptMedia MediaMap (InputMediaMap a)
outputMediaMap Method
outputAccept
forall a.
([(MediaType, a)] -> Method -> Maybe a)
-> MediaMap a -> Method -> Maybe a
lookupMediaMapBy forall b. [(MediaType, b)] -> Method -> Maybe b
mapContentMedia MediaMap a
inputMediaMap Method
inputContentType
newtype ApiNormal a = ApiNormal (MethodMap (OutputMediaMap (InputMediaMap a)))
deriving (Int -> ApiNormal a -> ShowS
forall a. Show a => Int -> ApiNormal a -> ShowS
forall a. Show a => [ApiNormal a] -> ShowS
forall a. Show a => ApiNormal a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiNormal a] -> ShowS
$cshowList :: forall a. Show a => [ApiNormal a] -> ShowS
show :: ApiNormal a -> String
$cshow :: forall a. Show a => ApiNormal a -> String
showsPrec :: Int -> ApiNormal a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ApiNormal a -> ShowS
Show, ApiNormal a -> ApiNormal a -> Bool
forall a. Eq a => ApiNormal a -> ApiNormal a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiNormal a -> ApiNormal a -> Bool
$c/= :: forall a. Eq a => ApiNormal a -> ApiNormal a -> Bool
== :: ApiNormal a -> ApiNormal a -> Bool
$c== :: forall a. Eq a => ApiNormal a -> ApiNormal a -> Bool
Eq, forall a b. a -> ApiNormal b -> ApiNormal a
forall a b. (a -> b) -> ApiNormal a -> ApiNormal 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 -> ApiNormal b -> ApiNormal a
$c<$ :: forall a b. a -> ApiNormal b -> ApiNormal a
fmap :: forall a b. (a -> b) -> ApiNormal a -> ApiNormal b
$cfmap :: forall a b. (a -> b) -> ApiNormal a -> ApiNormal b
Functor)
type MethodMap a = Map Method a
newtype InputMediaMap a = InputMediaMap (MediaMap a)
deriving (Int -> InputMediaMap a -> ShowS
forall a. Show a => Int -> InputMediaMap a -> ShowS
forall a. Show a => [InputMediaMap a] -> ShowS
forall a. Show a => InputMediaMap a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputMediaMap a] -> ShowS
$cshowList :: forall a. Show a => [InputMediaMap a] -> ShowS
show :: InputMediaMap a -> String
$cshow :: forall a. Show a => InputMediaMap a -> String
showsPrec :: Int -> InputMediaMap a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> InputMediaMap a -> ShowS
Show, InputMediaMap a -> InputMediaMap a -> Bool
forall a. Eq a => InputMediaMap a -> InputMediaMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputMediaMap a -> InputMediaMap a -> Bool
$c/= :: forall a. Eq a => InputMediaMap a -> InputMediaMap a -> Bool
== :: InputMediaMap a -> InputMediaMap a -> Bool
$c== :: forall a. Eq a => InputMediaMap a -> InputMediaMap a -> Bool
Eq, forall a b. a -> InputMediaMap b -> InputMediaMap a
forall a b. (a -> b) -> InputMediaMap a -> InputMediaMap 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 -> InputMediaMap b -> InputMediaMap a
$c<$ :: forall a b. a -> InputMediaMap b -> InputMediaMap a
fmap :: forall a b. (a -> b) -> InputMediaMap a -> InputMediaMap b
$cfmap :: forall a b. (a -> b) -> InputMediaMap a -> InputMediaMap b
Functor)
newtype OutputMediaMap a = OutputMediaMap (MediaMap a)
deriving (Int -> OutputMediaMap a -> ShowS
forall a. Show a => Int -> OutputMediaMap a -> ShowS
forall a. Show a => [OutputMediaMap a] -> ShowS
forall a. Show a => OutputMediaMap a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OutputMediaMap a] -> ShowS
$cshowList :: forall a. Show a => [OutputMediaMap a] -> ShowS
show :: OutputMediaMap a -> String
$cshow :: forall a. Show a => OutputMediaMap a -> String
showsPrec :: Int -> OutputMediaMap a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> OutputMediaMap a -> ShowS
Show, OutputMediaMap a -> OutputMediaMap a -> Bool
forall a. Eq a => OutputMediaMap a -> OutputMediaMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OutputMediaMap a -> OutputMediaMap a -> Bool
$c/= :: forall a. Eq a => OutputMediaMap a -> OutputMediaMap a -> Bool
== :: OutputMediaMap a -> OutputMediaMap a -> Bool
$c== :: forall a. Eq a => OutputMediaMap a -> OutputMediaMap a -> Bool
Eq, forall a b. a -> OutputMediaMap b -> OutputMediaMap a
forall a b. (a -> b) -> OutputMediaMap a -> OutputMediaMap 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 -> OutputMediaMap b -> OutputMediaMap a
$c<$ :: forall a b. a -> OutputMediaMap b -> OutputMediaMap a
fmap :: forall a b. (a -> b) -> OutputMediaMap a -> OutputMediaMap b
$cfmap :: forall a b. (a -> b) -> OutputMediaMap a -> OutputMediaMap b
Functor)
data MediaMap a = MediaMap
{ forall a. MediaMap a -> [(MediaType, a)]
mapValues :: [(MediaType, a)]
, forall a. MediaMap a -> a
matchAll :: a
}
deriving (Int -> MediaMap a -> ShowS
forall a. Show a => Int -> MediaMap a -> ShowS
forall a. Show a => [MediaMap a] -> ShowS
forall a. Show a => MediaMap a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MediaMap a] -> ShowS
$cshowList :: forall a. Show a => [MediaMap a] -> ShowS
show :: MediaMap a -> String
$cshow :: forall a. Show a => MediaMap a -> String
showsPrec :: Int -> MediaMap a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MediaMap a -> ShowS
Show, MediaMap a -> MediaMap a -> Bool
forall a. Eq a => MediaMap a -> MediaMap a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MediaMap a -> MediaMap a -> Bool
$c/= :: forall a. Eq a => MediaMap a -> MediaMap a -> Bool
== :: MediaMap a -> MediaMap a -> Bool
$c== :: forall a. Eq a => MediaMap a -> MediaMap a -> Bool
Eq, forall a b. a -> MediaMap b -> MediaMap a
forall a b. (a -> b) -> MediaMap a -> MediaMap 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 -> MediaMap b -> MediaMap a
$c<$ :: forall a b. a -> MediaMap b -> MediaMap a
fmap :: forall a b. (a -> b) -> MediaMap a -> MediaMap b
$cfmap :: forall a b. (a -> b) -> MediaMap a -> MediaMap b
Functor)
lookupMediaMapBy :: ([(MediaType, a)] -> ByteString -> Maybe a) -> MediaMap a -> ByteString -> Maybe a
lookupMediaMapBy :: forall a.
([(MediaType, a)] -> Method -> Maybe a)
-> MediaMap a -> Method -> Maybe a
lookupMediaMapBy [(MediaType, a)] -> Method -> Maybe a
getter (MediaMap [(MediaType, a)]
m a
matchAll) Method
media
| Method
media forall a. Eq a => a -> a -> Bool
== Method
"*/*" = forall a. a -> Maybe a
Just a
matchAll
| Bool
otherwise = [(MediaType, a)] -> Method -> Maybe a
getter [(MediaType, a)]
m Method
media
newtype Path = Path {Path -> [PathItem]
unPath :: [PathItem]}
deriving newtype (Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show, Path -> Path -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq, Eq Path
Path -> Path -> Bool
Path -> Path -> Ordering
Path -> Path -> Path
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
min :: Path -> Path -> Path
$cmin :: Path -> Path -> Path
max :: Path -> Path -> Path
$cmax :: Path -> Path -> Path
>= :: Path -> Path -> Bool
$c>= :: Path -> Path -> Bool
> :: Path -> Path -> Bool
$c> :: Path -> Path -> Bool
<= :: Path -> Path -> Bool
$c<= :: Path -> Path -> Bool
< :: Path -> Path -> Bool
$c< :: Path -> Path -> Bool
compare :: Path -> Path -> Ordering
$ccompare :: Path -> Path -> Ordering
Ord, NonEmpty Path -> Path
Path -> Path -> Path
forall b. Integral b => b -> Path -> Path
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> Path -> Path
$cstimes :: forall b. Integral b => b -> Path -> Path
sconcat :: NonEmpty Path -> Path
$csconcat :: NonEmpty Path -> Path
<> :: Path -> Path -> Path
$c<> :: Path -> Path -> Path
Semigroup, Semigroup Path
Path
[Path] -> Path
Path -> Path -> Path
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Path] -> Path
$cmconcat :: [Path] -> Path
mappend :: Path -> Path -> Path
$cmappend :: Path -> Path -> Path
mempty :: Path
$cmempty :: Path
Monoid)
instance ToHttpApiData Path where
toUrlPiece :: Path -> Text
toUrlPiece (Path [PathItem]
ps) = Text -> [Text] -> Text
Text.intercalate Text
"/" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. ToHttpApiData a => a -> Text
toUrlPiece [PathItem]
ps
instance ToHttpApiData PathItem where
toUrlPiece :: PathItem -> Text
toUrlPiece = \case
StaticPath Text
txt -> Text
txt
CapturePath Text
txt -> Text
"{" forall a. Semigroup a => a -> a -> a
<> Text
txt forall a. Semigroup a => a -> a -> a
<> Text
"}"
instance IsString Path where
fromString :: String -> Path
fromString =
[PathItem] -> Path
Path forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> PathItem
replaceCapture forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isPathSeparator) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitDirectories
where
replaceCapture :: Text -> PathItem
replaceCapture :: Text -> PathItem
replaceCapture Text
path
| Text -> Char
Text.head Text
path forall a. Eq a => a -> a -> Bool
== Char
'$' = Text -> PathItem
CapturePath (Text -> Text
Text.tail Text
path)
| Text
path forall a. Eq a => a -> a -> Bool
== Text
"*" = Text -> PathItem
CapturePath Text
path
| Bool
otherwise = Text -> PathItem
StaticPath Text
path
data PathItem
= StaticPath Text
| CapturePath Text
deriving (Int -> PathItem -> ShowS
[PathItem] -> ShowS
PathItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PathItem] -> ShowS
$cshowList :: [PathItem] -> ShowS
show :: PathItem -> String
$cshow :: PathItem -> String
showsPrec :: Int -> PathItem -> ShowS
$cshowsPrec :: Int -> PathItem -> ShowS
Show, PathItem -> PathItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PathItem -> PathItem -> Bool
$c/= :: PathItem -> PathItem -> Bool
== :: PathItem -> PathItem -> Bool
$c== :: PathItem -> PathItem -> Bool
Eq, Eq PathItem
PathItem -> PathItem -> Bool
PathItem -> PathItem -> Ordering
PathItem -> PathItem -> PathItem
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
min :: PathItem -> PathItem -> PathItem
$cmin :: PathItem -> PathItem -> PathItem
max :: PathItem -> PathItem -> PathItem
$cmax :: PathItem -> PathItem -> PathItem
>= :: PathItem -> PathItem -> Bool
$c>= :: PathItem -> PathItem -> Bool
> :: PathItem -> PathItem -> Bool
$c> :: PathItem -> PathItem -> Bool
<= :: PathItem -> PathItem -> Bool
$c<= :: PathItem -> PathItem -> Bool
< :: PathItem -> PathItem -> Bool
$c< :: PathItem -> PathItem -> Bool
compare :: PathItem -> PathItem -> Ordering
$ccompare :: PathItem -> PathItem -> Ordering
Ord)
type CaptureMap = Map Text Text
getPath :: [Text] -> Api a -> Maybe (a, CaptureMap)
getPath :: forall a. [Text] -> Api a -> Maybe (a, CaptureMap)
getPath [Text]
mainPath = forall a. CaptureMap -> [Text] -> Api 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] -> Api a -> Maybe (a, CaptureMap)
go :: forall a. CaptureMap -> [Text] -> Api a -> Maybe (a, CaptureMap)
go !CaptureMap
captureMap [Text]
path Api a
api =
case [Text]
path of
[] -> case Api a
api of
HandleRoute a
a -> forall a. a -> Maybe a
Just (a
a, CaptureMap
captureMap)
Append Api a
a Api a
b -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. CaptureMap -> [Text] -> Api a -> Maybe (a, CaptureMap)
go CaptureMap
captureMap [Text]
path Api a
b) forall a. a -> Maybe a
Just (forall a. CaptureMap -> [Text] -> Api a -> Maybe (a, CaptureMap)
go CaptureMap
captureMap [Text]
path Api a
a)
Api a
_ -> forall a. Maybe a
Nothing
Text
p : [Text]
rest -> case Api a
api of
WithPath Path
template Api a
restApi -> forall {a}.
CaptureMap
-> Text -> [Text] -> Path -> Api a -> Maybe (a, CaptureMap)
goPath CaptureMap
captureMap Text
p [Text]
rest Path
template Api a
restApi
Append Api a
a Api a
b -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. CaptureMap -> [Text] -> Api a -> Maybe (a, CaptureMap)
go CaptureMap
captureMap [Text]
path Api a
b) forall a. a -> Maybe a
Just (forall a. CaptureMap -> [Text] -> Api a -> Maybe (a, CaptureMap)
go CaptureMap
captureMap [Text]
path Api a
a)
Api a
_ -> forall a. Maybe a
Nothing
goPath :: CaptureMap
-> Text -> [Text] -> Path -> Api a -> Maybe (a, CaptureMap)
goPath !CaptureMap
captureMap !Text
pathHead ![Text]
pathTail (Path ![PathItem]
template) Api a
restApi =
case [PathItem]
template of
[] -> forall a. CaptureMap -> [Text] -> Api a -> Maybe (a, CaptureMap)
go CaptureMap
captureMap (Text
pathHead forall a. a -> [a] -> [a]
: [Text]
pathTail) Api a
restApi
StaticPath Text
apiHead : [PathItem]
templateRest ->
if Text
pathHead forall a. Eq a => a -> a -> Bool
== Text
apiHead
then CaptureMap
-> [Text] -> [PathItem] -> Api a -> Maybe (a, CaptureMap)
goPathNext CaptureMap
captureMap [Text]
pathTail [PathItem]
templateRest Api a
restApi
else forall a. Maybe a
Nothing
CapturePath Text
name : [PathItem]
templateRest ->
let nextCaptureMap :: CaptureMap
nextCaptureMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
name Text
pathHead CaptureMap
captureMap
in CaptureMap
-> [Text] -> [PathItem] -> Api a -> Maybe (a, CaptureMap)
goPathNext CaptureMap
nextCaptureMap [Text]
pathTail [PathItem]
templateRest Api a
restApi
goPathNext :: CaptureMap
-> [Text] -> [PathItem] -> Api a -> Maybe (a, CaptureMap)
goPathNext !CaptureMap
captureMap ![Text]
pathTail ![PathItem]
templateRest Api a
restApi =
case [PathItem]
templateRest of
[] -> forall a. CaptureMap -> [Text] -> Api a -> Maybe (a, CaptureMap)
go CaptureMap
captureMap [Text]
pathTail Api a
restApi
[PathItem]
_ -> case [Text]
pathTail of
Text
nextPathHead : [Text]
nextPathTail -> CaptureMap
-> Text -> [Text] -> Path -> Api a -> Maybe (a, CaptureMap)
goPath CaptureMap
captureMap Text
nextPathHead [Text]
nextPathTail ([PathItem] -> Path
Path [PathItem]
templateRest) Api a
restApi
[] -> forall a. Maybe a
Nothing
flatApi :: Api a -> [(Path, a)]
flatApi :: forall a. Api a -> [(Path, a)]
flatApi = forall {b}. Path -> Api b -> [(Path, b)]
go forall a. Monoid a => a
mempty
where
go :: Path -> Api b -> [(Path, b)]
go Path
prefix = \case
Api b
Empty -> forall a. Monoid a => a
mempty
Append Api b
a Api b
b -> Path -> Api b -> [(Path, b)]
go Path
prefix Api b
a forall a. Semigroup a => a -> a -> a
<> Path -> Api b -> [(Path, b)]
go Path
prefix Api b
b
WithPath Path
path Api b
a -> Path -> Api b -> [(Path, b)]
go (Path
prefix forall a. Semigroup a => a -> a -> a
<> Path
path) Api b
a
HandleRoute b
a -> [(Path
prefix, b
a)]
fromFlatApi :: [(Path, a)] -> Api a
fromFlatApi :: forall a. [(Path, a)] -> Api a
fromFlatApi = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Path
path, a
route) -> forall a. Path -> Api a -> Api a
WithPath Path
path (forall a. a -> Api a
HandleRoute a
route))