{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# OPTIONS_GHC -fno-warn-orphans  #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Router
-- Copyright   :  (C) 2016-2018 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <djohnson.m@gmail.com>
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
module Miso.Router
  ( runRoute
  , route
  , HasRouter
  , RouteT
  , RoutingError (..)
  ) where

import qualified Data.ByteString.Char8 as BS
import           Data.Proxy
import           Data.Text             (Text)
import qualified Data.Text             as T
import           Data.Text.Encoding
import           GHC.TypeLits
import           Network.HTTP.Types    hiding (Header)
import           Network.URI
import           Servant.API
import           Web.HttpApiData

import           Miso.Html             hiding (text)

-- | Router terminator.
-- The 'HasRouter' instance for 'View' finalizes the router.
--
-- Example:
--
-- > type MyApi = "books" :> Capture "bookId" Int :> View

-- | 'Location' is used to split the path and query of a URI into components.
data Location = Location
  { Location -> [Text]
locPath  :: [Text]
  , Location -> Query
locQuery :: Query
  } deriving (Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show, Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq, Eq Location
Eq Location
-> (Location -> Location -> Ordering)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Bool)
-> (Location -> Location -> Location)
-> (Location -> Location -> Location)
-> Ord Location
Location -> Location -> Bool
Location -> Location -> Ordering
Location -> Location -> Location
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 :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmax :: Location -> Location -> Location
>= :: Location -> Location -> Bool
$c>= :: Location -> Location -> Bool
> :: Location -> Location -> Bool
$c> :: Location -> Location -> Bool
<= :: Location -> Location -> Bool
$c<= :: Location -> Location -> Bool
< :: Location -> Location -> Bool
$c< :: Location -> Location -> Bool
compare :: Location -> Location -> Ordering
$ccompare :: Location -> Location -> Ordering
$cp1Ord :: Eq Location
Ord)

-- | When routing, the router may fail to match a location.
data RoutingError = Fail
  deriving (Int -> RoutingError -> ShowS
[RoutingError] -> ShowS
RoutingError -> String
(Int -> RoutingError -> ShowS)
-> (RoutingError -> String)
-> ([RoutingError] -> ShowS)
-> Show RoutingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoutingError] -> ShowS
$cshowList :: [RoutingError] -> ShowS
show :: RoutingError -> String
$cshow :: RoutingError -> String
showsPrec :: Int -> RoutingError -> ShowS
$cshowsPrec :: Int -> RoutingError -> ShowS
Show, RoutingError -> RoutingError -> Bool
(RoutingError -> RoutingError -> Bool)
-> (RoutingError -> RoutingError -> Bool) -> Eq RoutingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RoutingError -> RoutingError -> Bool
$c/= :: RoutingError -> RoutingError -> Bool
== :: RoutingError -> RoutingError -> Bool
$c== :: RoutingError -> RoutingError -> Bool
Eq, Eq RoutingError
Eq RoutingError
-> (RoutingError -> RoutingError -> Ordering)
-> (RoutingError -> RoutingError -> Bool)
-> (RoutingError -> RoutingError -> Bool)
-> (RoutingError -> RoutingError -> Bool)
-> (RoutingError -> RoutingError -> Bool)
-> (RoutingError -> RoutingError -> RoutingError)
-> (RoutingError -> RoutingError -> RoutingError)
-> Ord RoutingError
RoutingError -> RoutingError -> Bool
RoutingError -> RoutingError -> Ordering
RoutingError -> RoutingError -> RoutingError
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 :: RoutingError -> RoutingError -> RoutingError
$cmin :: RoutingError -> RoutingError -> RoutingError
max :: RoutingError -> RoutingError -> RoutingError
$cmax :: RoutingError -> RoutingError -> RoutingError
>= :: RoutingError -> RoutingError -> Bool
$c>= :: RoutingError -> RoutingError -> Bool
> :: RoutingError -> RoutingError -> Bool
$c> :: RoutingError -> RoutingError -> Bool
<= :: RoutingError -> RoutingError -> Bool
$c<= :: RoutingError -> RoutingError -> Bool
< :: RoutingError -> RoutingError -> Bool
$c< :: RoutingError -> RoutingError -> Bool
compare :: RoutingError -> RoutingError -> Ordering
$ccompare :: RoutingError -> RoutingError -> Ordering
$cp1Ord :: Eq RoutingError
Ord)

-- | A 'Router' contains the information necessary to execute a handler.
data Router a where
  RChoice       :: Router a -> Router a -> Router a
  RCapture      :: FromHttpApiData x => (x -> Router a) -> Router a
  RQueryParam   :: (FromHttpApiData x, KnownSymbol sym)
                   => Proxy sym -> (Maybe x -> Router a) -> Router a
  RQueryParams  :: (FromHttpApiData x, KnownSymbol sym)
                   => Proxy sym -> ([x] -> Router a) -> Router a
  RQueryFlag    :: KnownSymbol sym
                   => Proxy sym -> (Bool -> Router a) -> Router a
  RPath         :: KnownSymbol sym => Proxy sym -> Router a -> Router a
  RPage         :: a -> Router a

-- | This is similar to the @HasServer@ class from @servant-server@.
-- It is the class responsible for making API combinators routable.
-- 'RouteT' is used to build up the handler types.
-- 'Router' is returned, to be interpretted by 'routeLoc'.
class HasRouter layout where
  -- | A mkRouter handler.
  type RouteT layout a :: *
  -- | Transform a mkRouter handler into a 'Router'.
  mkRouter :: Proxy layout -> Proxy a -> RouteT layout a -> Router a

-- | Alternative
instance (HasRouter x, HasRouter y) => HasRouter (x :<|> y) where
  type RouteT (x :<|> y) a = RouteT x a :<|> RouteT y a
  mkRouter :: Proxy (x :<|> y) -> Proxy a -> RouteT (x :<|> y) a -> Router a
mkRouter Proxy (x :<|> y)
_ (Proxy a
a :: Proxy a) ((x :: RouteT x a) :<|> (y :: RouteT y a))
    = Router a -> Router a -> Router a
forall a. Router a -> Router a -> Router a
RChoice (Proxy x -> Proxy a -> RouteT x a -> Router a
forall k (layout :: k) a.
HasRouter layout =>
Proxy layout -> Proxy a -> RouteT layout a -> Router a
mkRouter (Proxy x
forall k (t :: k). Proxy t
Proxy :: Proxy x) Proxy a
a RouteT x a
x) (Proxy y -> Proxy a -> RouteT y a -> Router a
forall k (layout :: k) a.
HasRouter layout =>
Proxy layout -> Proxy a -> RouteT layout a -> Router a
mkRouter (Proxy y
forall k (t :: k). Proxy t
Proxy :: Proxy y) Proxy a
a RouteT y a
y)

-- | Capture
instance (HasRouter sublayout, FromHttpApiData x) =>
  HasRouter (Capture sym x :> sublayout) where
  type RouteT (Capture sym x :> sublayout) a = x -> RouteT sublayout a
  mkRouter :: Proxy (Capture sym x :> sublayout)
-> Proxy a -> RouteT (Capture sym x :> sublayout) a -> Router a
mkRouter Proxy (Capture sym x :> sublayout)
_ Proxy a
a RouteT (Capture sym x :> sublayout) a
f = (x -> Router a) -> Router a
forall x a. FromHttpApiData x => (x -> Router a) -> Router a
RCapture (\x
x -> Proxy sublayout -> Proxy a -> RouteT sublayout a -> Router a
forall k (layout :: k) a.
HasRouter layout =>
Proxy layout -> Proxy a -> RouteT layout a -> Router a
mkRouter (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout) Proxy a
a (RouteT (Capture sym x :> sublayout) a
x -> RouteT sublayout a
f x
x))

-- | QueryParam
instance (HasRouter sublayout, FromHttpApiData x, KnownSymbol sym)
         => HasRouter (QueryParam sym x :> sublayout) where
  type RouteT (QueryParam sym x :> sublayout) a = Maybe x -> RouteT sublayout a
  mkRouter :: Proxy (QueryParam sym x :> sublayout)
-> Proxy a -> RouteT (QueryParam sym x :> sublayout) a -> Router a
mkRouter Proxy (QueryParam sym x :> sublayout)
_ Proxy a
a RouteT (QueryParam sym x :> sublayout) a
f = Proxy sym -> (Maybe x -> Router a) -> Router a
forall x (sym :: Symbol) a.
(FromHttpApiData x, KnownSymbol sym) =>
Proxy sym -> (Maybe x -> Router a) -> Router a
RQueryParam (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
    (\Maybe x
x -> Proxy sublayout -> Proxy a -> RouteT sublayout a -> Router a
forall k (layout :: k) a.
HasRouter layout =>
Proxy layout -> Proxy a -> RouteT layout a -> Router a
mkRouter (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout) Proxy a
a (RouteT (QueryParam sym x :> sublayout) a
Maybe x -> RouteT sublayout a
f Maybe x
x))

-- | QueryParams
instance (HasRouter sublayout, FromHttpApiData x, KnownSymbol sym)
         => HasRouter (QueryParams sym x :> sublayout) where
  type RouteT (QueryParams sym x :> sublayout) a = [x] -> RouteT sublayout a
  mkRouter :: Proxy (QueryParams sym x :> sublayout)
-> Proxy a -> RouteT (QueryParams sym x :> sublayout) a -> Router a
mkRouter Proxy (QueryParams sym x :> sublayout)
_ Proxy a
a RouteT (QueryParams sym x :> sublayout) a
f = Proxy sym -> ([x] -> Router a) -> Router a
forall x (sym :: Symbol) a.
(FromHttpApiData x, KnownSymbol sym) =>
Proxy sym -> ([x] -> Router a) -> Router a
RQueryParams
    (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
    (\[x]
x -> Proxy sublayout -> Proxy a -> RouteT sublayout a -> Router a
forall k (layout :: k) a.
HasRouter layout =>
Proxy layout -> Proxy a -> RouteT layout a -> Router a
mkRouter (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout) Proxy a
a (RouteT (QueryParams sym x :> sublayout) a
[x] -> RouteT sublayout a
f [x]
x))

-- | QueryFlag
instance (HasRouter sublayout, KnownSymbol sym)
         => HasRouter (QueryFlag sym :> sublayout) where
  type RouteT (QueryFlag sym :> sublayout) a = Bool -> RouteT sublayout a
  mkRouter :: Proxy (QueryFlag sym :> sublayout)
-> Proxy a -> RouteT (QueryFlag sym :> sublayout) a -> Router a
mkRouter Proxy (QueryFlag sym :> sublayout)
_ Proxy a
a RouteT (QueryFlag sym :> sublayout) a
f = Proxy sym -> (Bool -> Router a) -> Router a
forall (sym :: Symbol) a.
KnownSymbol sym =>
Proxy sym -> (Bool -> Router a) -> Router a
RQueryFlag
    (Proxy sym
forall k (t :: k). Proxy t
Proxy :: Proxy sym)
    (\Bool
x -> Proxy sublayout -> Proxy a -> RouteT sublayout a -> Router a
forall k (layout :: k) a.
HasRouter layout =>
Proxy layout -> Proxy a -> RouteT layout a -> Router a
mkRouter (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout) Proxy a
a (RouteT (QueryFlag sym :> sublayout) a
Bool -> RouteT sublayout a
f Bool
x))

-- | Header
instance HasRouter sublayout => HasRouter (Header sym (x :: *) :> sublayout) where
    type RouteT (Header sym x :> sublayout) a = Maybe x -> RouteT sublayout a
    mkRouter :: Proxy (Header sym x :> sublayout)
-> Proxy a -> RouteT (Header sym x :> sublayout) a -> Router a
mkRouter Proxy (Header sym x :> sublayout)
_ Proxy a
a RouteT (Header sym x :> sublayout) a
f = Proxy sublayout -> Proxy a -> RouteT sublayout a -> Router a
forall k (layout :: k) a.
HasRouter layout =>
Proxy layout -> Proxy a -> RouteT layout a -> Router a
mkRouter (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout) Proxy a
a (RouteT (Header sym x :> sublayout) a
Maybe x -> RouteT sublayout a
f Maybe x
forall a. Maybe a
Nothing)

-- | Path
instance (HasRouter sublayout, KnownSymbol path)
         => HasRouter (path :> sublayout) where
  type RouteT (path :> sublayout) a = RouteT sublayout a
  mkRouter :: Proxy (path :> sublayout)
-> Proxy a -> RouteT (path :> sublayout) a -> Router a
mkRouter Proxy (path :> sublayout)
_ Proxy a
a RouteT (path :> sublayout) a
page = Proxy path -> Router a -> Router a
forall (sym :: Symbol) a.
KnownSymbol sym =>
Proxy sym -> Router a -> Router a
RPath
    (Proxy path
forall k (t :: k). Proxy t
Proxy :: Proxy path)
    (Proxy sublayout -> Proxy a -> RouteT sublayout a -> Router a
forall k (layout :: k) a.
HasRouter layout =>
Proxy layout -> Proxy a -> RouteT layout a -> Router a
mkRouter (Proxy sublayout
forall k (t :: k). Proxy t
Proxy :: Proxy sublayout) Proxy a
a RouteT sublayout a
RouteT (path :> sublayout) a
page)

-- | View
instance HasRouter (View a) where
  type RouteT (View a) x = x
  mkRouter :: Proxy (View a) -> Proxy a -> RouteT (View a) a -> Router a
mkRouter Proxy (View a)
_ Proxy a
_ RouteT (View a) a
a = a -> Router a
forall a. a -> Router a
RPage a
RouteT (View a) a
a

-- | Verb
instance HasRouter (Verb m s c a) where
  type RouteT (Verb m s c a) x = x
  mkRouter :: Proxy (Verb m s c a)
-> Proxy a -> RouteT (Verb m s c a) a -> Router a
mkRouter Proxy (Verb m s c a)
_ Proxy a
_ RouteT (Verb m s c a) a
a = a -> Router a
forall a. a -> Router a
RPage a
RouteT (Verb m s c a) a
a

-- | Raw
instance HasRouter Raw where
  type RouteT Raw x = x
  mkRouter :: Proxy Raw -> Proxy a -> RouteT Raw a -> Router a
mkRouter Proxy Raw
_ Proxy a
_ RouteT Raw a
a = a -> Router a
forall a. a -> Router a
RPage a
RouteT Raw a
a

-- | Use a handler to mkRouter a 'Location'.
-- Normally 'route' should be used instead, unless you want custom
-- handling of string failing to parse as 'URI'.
runRouteLoc :: forall layout a. HasRouter layout
            => Location -> Proxy layout -> RouteT layout a ->  Either RoutingError a
runRouteLoc :: Location
-> Proxy layout -> RouteT layout a -> Either RoutingError a
runRouteLoc Location
loc Proxy layout
layout RouteT layout a
page =
  let routing :: Router a
routing = Proxy layout -> Proxy a -> RouteT layout a -> Router a
forall k (layout :: k) a.
HasRouter layout =>
Proxy layout -> Proxy a -> RouteT layout a -> Router a
mkRouter Proxy layout
layout (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a) RouteT layout a
page
  in Location -> Router a -> Either RoutingError a
forall a. Location -> Router a -> Either RoutingError a
routeLoc Location
loc Router a
routing

-- | Use a handler to mkRouter a location, represented as a 'String'.
-- All handlers must, in the end, return @m a@.
-- 'routeLoc' will choose a mkRouter and return its result.
route
  :: HasRouter layout
  => Proxy layout
  -> RouteT layout a
  -> URI
  -> Either RoutingError a
route :: Proxy layout -> RouteT layout a -> URI -> Either RoutingError a
route Proxy layout
layout RouteT layout a
handler URI
u = Location
-> Proxy layout -> RouteT layout a -> Either RoutingError a
forall k (layout :: k) a.
HasRouter layout =>
Location
-> Proxy layout -> RouteT layout a -> Either RoutingError a
runRouteLoc (URI -> Location
uriToLocation URI
u) Proxy layout
layout RouteT layout a
handler

-- | Executes router
runRoute
  :: HasRouter layout
  => Proxy layout
  -> RouteT layout (m -> a)
  -> (m -> URI)
  -> m
  -> Either RoutingError a
runRoute :: Proxy layout
-> RouteT layout (m -> a)
-> (m -> URI)
-> m
-> Either RoutingError a
runRoute Proxy layout
layout RouteT layout (m -> a)
pages m -> URI
getURI m
model = ((m -> a) -> m -> a
forall a b. (a -> b) -> a -> b
$ m
model) ((m -> a) -> a)
-> Either RoutingError (m -> a) -> Either RoutingError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy layout
-> RouteT layout (m -> a) -> URI -> Either RoutingError (m -> a)
forall k (layout :: k) a.
HasRouter layout =>
Proxy layout -> RouteT layout a -> URI -> Either RoutingError a
route Proxy layout
layout RouteT layout (m -> a)
pages (m -> URI
getURI m
model)

-- | Use a computed 'Router' to mkRouter a 'Location'.
routeLoc :: Location -> Router a -> Either RoutingError a
routeLoc :: Location -> Router a -> Either RoutingError a
routeLoc Location
loc Router a
r = case Router a
r of
  RChoice Router a
a Router a
b -> do
    case Location -> Router a -> Either RoutingError a
forall a. Location -> Router a -> Either RoutingError a
routeLoc Location
loc Router a
a of
      Left RoutingError
Fail -> Location -> Router a -> Either RoutingError a
forall a. Location -> Router a -> Either RoutingError a
routeLoc Location
loc Router a
b
      Right a
x -> a -> Either RoutingError a
forall a b. b -> Either a b
Right a
x
  RCapture x -> Router a
f -> case Location -> [Text]
locPath Location
loc of
    [] -> RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left RoutingError
Fail
    Text
capture:[Text]
paths ->
      case Text -> Maybe x
forall a. FromHttpApiData a => Text -> Maybe a
parseUrlPieceMaybe Text
capture of
        Maybe x
Nothing -> RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left RoutingError
Fail
        Just x
x -> Location -> Router a -> Either RoutingError a
forall a. Location -> Router a -> Either RoutingError a
routeLoc Location
loc { locPath :: [Text]
locPath = [Text]
paths } (x -> Router a
f x
x)
  RQueryParam Proxy sym
sym Maybe x -> Router a
f -> case ByteString -> Query -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy sym
sym) (Location -> Query
locQuery Location
loc) of
    Maybe (Maybe ByteString)
Nothing -> Location -> Router a -> Either RoutingError a
forall a. Location -> Router a -> Either RoutingError a
routeLoc Location
loc (Maybe x -> Router a
f Maybe x
forall a. Maybe a
Nothing)
    Just Maybe ByteString
Nothing -> RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left RoutingError
Fail
    Just (Just ByteString
text) -> case Text -> Maybe x
forall a. FromHttpApiData a => Text -> Maybe a
parseQueryParamMaybe (ByteString -> Text
decodeUtf8 ByteString
text) of
      Maybe x
Nothing -> RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left RoutingError
Fail
      Just x
x -> Location -> Router a -> Either RoutingError a
forall a. Location -> Router a -> Either RoutingError a
routeLoc Location
loc (Maybe x -> Router a
f (x -> Maybe x
forall a. a -> Maybe a
Just x
x))
  RQueryParams Proxy sym
sym [x] -> Router a
f -> Either RoutingError a
-> ([x] -> Either RoutingError a)
-> Maybe [x]
-> Either RoutingError a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left RoutingError
Fail) (\[x]
x -> Location -> Router a -> Either RoutingError a
forall a. Location -> Router a -> Either RoutingError a
routeLoc Location
loc ([x] -> Router a
f [x]
x)) (Maybe [x] -> Either RoutingError a)
-> Maybe [x] -> Either RoutingError a
forall a b. (a -> b) -> a -> b
$ do
    [ByteString]
ps <- [Maybe ByteString] -> Maybe [ByteString]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe ByteString] -> Maybe [ByteString])
-> [Maybe ByteString] -> Maybe [ByteString]
forall a b. (a -> b) -> a -> b
$ (ByteString, Maybe ByteString) -> Maybe ByteString
forall a b. (a, b) -> b
snd ((ByteString, Maybe ByteString) -> Maybe ByteString)
-> Query -> [Maybe ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ByteString, Maybe ByteString) -> Bool) -> Query -> Query
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter
      (\(ByteString
k, Maybe ByteString
_) -> ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
BS.pack (Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy sym
sym)) (Location -> Query
locQuery Location
loc)
    [Maybe x] -> Maybe [x]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe x] -> Maybe [x]) -> [Maybe x] -> Maybe [x]
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe x
forall a. FromHttpApiData a => Text -> Maybe a
parseQueryParamMaybe (Text -> Maybe x) -> (ByteString -> Text) -> ByteString -> Maybe x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8) (ByteString -> Maybe x) -> [ByteString] -> [Maybe x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ByteString]
ps
  RQueryFlag Proxy sym
sym Bool -> Router a
f -> case ByteString -> Query -> Maybe (Maybe ByteString)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String -> ByteString
BS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy sym
sym) (Location -> Query
locQuery Location
loc) of
    Maybe (Maybe ByteString)
Nothing -> Location -> Router a -> Either RoutingError a
forall a. Location -> Router a -> Either RoutingError a
routeLoc Location
loc (Bool -> Router a
f Bool
False)
    Just Maybe ByteString
Nothing -> Location -> Router a -> Either RoutingError a
forall a. Location -> Router a -> Either RoutingError a
routeLoc Location
loc (Bool -> Router a
f Bool
True)
    Just (Just ByteString
_) -> RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left RoutingError
Fail
  RPath Proxy sym
sym Router a
a -> case Location -> [Text]
locPath Location
loc of
    [] -> RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left RoutingError
Fail
    Text
p:[Text]
paths -> if Text
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Text
T.pack (Proxy sym -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal Proxy sym
sym)
      then Location -> Router a -> Either RoutingError a
forall a. Location -> Router a -> Either RoutingError a
routeLoc (Location
loc { locPath :: [Text]
locPath = [Text]
paths }) Router a
a
      else RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left RoutingError
Fail
  RPage a
a ->
    case Location -> [Text]
locPath Location
loc of
      [] -> a -> Either RoutingError a
forall a b. b -> Either a b
Right a
a
      [Text
""] -> a -> Either RoutingError a
forall a b. b -> Either a b
Right a
a
      [Text]
_ -> RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left RoutingError
Fail

-- | Convert a 'URI' to a 'Location'.
uriToLocation :: URI -> Location
uriToLocation :: URI -> Location
uriToLocation URI
uri = Location :: [Text] -> Query -> Location
Location
  { locPath :: [Text]
locPath = ByteString -> [Text]
decodePathSegments (ByteString -> [Text]) -> ByteString -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack (URI -> String
uriPath URI
uri)
  , locQuery :: Query
locQuery = ByteString -> Query
parseQuery (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack (URI -> String
uriQuery URI
uri)
  }