-- | Core API description
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

-- | HTTP API container
data Api a
  = -- | alternative between two API's
    Append (Api a) (Api a)
  | -- | an empty API that does nothing
    Empty
  | -- | path prefix for an API
    WithPath Path (Api a)
  | -- | handle route
    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

-- | Filters routes in the API with predicate
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

-- | converts API to efficient representation to fetch the route handlers by path
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)

        -- filter out any cases as they are covered by second argument of MediaMap value
        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)

-- | Read sub-api by HTTP method, accept-type and content-type
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

-- | Efficient representation of API to fetch routes
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)

-- | Mthod map
type MethodMap a = Map Method a

-- | filter by Content-Type header
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)

-- | filter by Accept header
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)

-- | Map by media type
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)

-- | Lookup value by media type key
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

{-| Path is a chain of elements which can be static types or capture.
There is @IsString@ instance which allows us to create paths from strings. Examples:

> "api/v1/foo" ==> Path [StaticPath "api", StaticPath "v1", StaticPath "foo"]
> "api/v1/*" ==> Path [StaticPath "api", StaticPath "v1", CapturePath "*"]
-}
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

-- | Path can be a static item or capture with a name
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)

{-| Map of capture values extracted from path.
Keys are capture names.
-}
type CaptureMap = Map Text Text

-- | Find an api item by path. Also it accumulates capture map along the way.
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

-- | Flattens API. Creates a flat list of paths and route handlers.
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)]

-- | Constructs API from flat list of pairs of paths and route handlers.
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))