-----------------------------------------------------------------------------
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE PolyKinds             #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Router
-- Copyright   :  (C) 2016-2025 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
----------------------------------------------------------------------------
module Miso.Router
  ( -- ** Classes
    HasRouter (..)
    -- ** Types
  , RoutingError (..)
  , Router
    -- ** Routing
  , route
  ) where
-----------------------------------------------------------------------------
import qualified Data.ByteString.Char8 as BS
import           Data.Kind
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.Types hiding (model)
-----------------------------------------------------------------------------
-- | 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
$cshowsPrec :: Int -> Location -> ShowS
showsPrec :: Int -> Location -> ShowS
$cshow :: Location -> String
show :: Location -> String
$cshowList :: [Location] -> ShowS
showList :: [Location] -> ShowS
Show, Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
/= :: 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
$ccompare :: Location -> Location -> Ordering
compare :: Location -> Location -> Ordering
$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
>= :: Location -> Location -> Bool
$cmax :: Location -> Location -> Location
max :: Location -> Location -> Location
$cmin :: Location -> Location -> Location
min :: Location -> Location -> 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
$cshowsPrec :: Int -> RoutingError -> ShowS
showsPrec :: Int -> RoutingError -> ShowS
$cshow :: RoutingError -> String
show :: RoutingError -> String
$cshowList :: [RoutingError] -> ShowS
showList :: [RoutingError] -> ShowS
Show, RoutingError -> RoutingError -> Bool
(RoutingError -> RoutingError -> Bool)
-> (RoutingError -> RoutingError -> Bool) -> Eq RoutingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RoutingError -> RoutingError -> Bool
== :: RoutingError -> RoutingError -> Bool
$c/= :: RoutingError -> RoutingError -> Bool
/= :: 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
$ccompare :: RoutingError -> RoutingError -> Ordering
compare :: RoutingError -> RoutingError -> Ordering
$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
>= :: RoutingError -> RoutingError -> Bool
$cmax :: RoutingError -> RoutingError -> RoutingError
max :: RoutingError -> RoutingError -> RoutingError
$cmin :: RoutingError -> RoutingError -> RoutingError
min :: RoutingError -> RoutingError -> 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.
class HasRouter layout where
  -- | Type family for route dispatch
  type RouteT layout a :: Type
  -- | 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 :: forall a.
Proxy (x :<|> y) -> Proxy a -> RouteT (x :<|> y) a -> Router a
mkRouter Proxy (x :<|> y)
_ (Proxy a
a :: Proxy a) ((RouteT x a
x :: RouteT x a) :<|> (RouteT y 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 a. 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 a. 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 :: forall a.
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 sym a. FromHttpApiData sym => (sym -> Router a) -> Router a
RCapture (\x
x -> Proxy sublayout -> Proxy a -> RouteT sublayout a -> Router a
forall a.
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 :: forall a.
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 sym (sym :: Symbol) a.
(FromHttpApiData sym, KnownSymbol sym) =>
Proxy sym -> (Maybe sym -> 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 a.
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 :: forall a.
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 sym (sym :: Symbol) a.
(FromHttpApiData sym, KnownSymbol sym) =>
Proxy sym -> ([sym] -> 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 a.
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 :: forall a.
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 a.
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 :: Type) :> sublayout) where
    type RouteT (Header sym x :> sublayout) a = Maybe x -> RouteT sublayout a
    mkRouter :: forall a.
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 a.
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 :: forall a.
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 a.
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 m a) where
  type RouteT (View m a) x = x
  mkRouter :: forall a.
Proxy (View m a) -> Proxy a -> RouteT (View m a) a -> Router a
mkRouter Proxy (View m a)
_ Proxy a
_ RouteT (View m a) a
a = a -> Router a
forall a. a -> Router a
RPage a
RouteT (View m a) a
a
-----------------------------------------------------------------------------
-- | Verb
instance HasRouter (Verb m s c a) where
  type RouteT (Verb m s c a) x = x
  mkRouter :: forall a.
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 :: forall a. 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@ as @Location@.
-- Normally @runRoute@ 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 :: forall {k} (layout :: k) a.
HasRouter layout =>
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 a. 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 computed 'Router' to mkRouter a 'Location'.
routeLoc :: Location -> Router a -> Either RoutingError a
routeLoc :: forall a. 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 = 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
txt) -> case Text -> Maybe x
forall a. FromHttpApiData a => Text -> Maybe a
parseQueryParamMaybe (ByteString -> Text
decodeUtf8 ByteString
txt) 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
    ps <- ((ByteString, Maybe ByteString) -> Maybe ByteString)
-> Query -> Maybe [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ByteString, Maybe ByteString) -> Maybe ByteString
forall a b. (a, b) -> b
snd (Query -> Maybe [ByteString]) -> Query -> Maybe [ByteString]
forall a b. (a -> b) -> a -> 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)
    mapM (parseQueryParamMaybe . decodeUtf8) 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 = 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
-----------------------------------------------------------------------------
-- | 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.
runRoute
  :: HasRouter layout
  => Proxy layout
  -> RouteT layout a
  -> URI
  -> Either RoutingError a
runRoute :: forall {k} (layout :: k) a.
HasRouter layout =>
Proxy layout -> RouteT layout a -> URI -> Either RoutingError a
runRoute 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
-- This is most likely the function you want to use. See <https://gitub.com/haskell-miso.org/shared/Common.hs> for usage.
route
  :: HasRouter layout
  => Proxy layout
  -> RouteT layout (m -> a)
  -> (m -> URI)
  -> m
  -> Either RoutingError a
route :: forall {k} (layout :: k) m a.
HasRouter layout =>
Proxy layout
-> RouteT layout (m -> a)
-> (m -> URI)
-> m
-> Either RoutingError a
route 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
runRoute Proxy layout
layout RouteT layout (m -> a)
pages (m -> URI
getURI m
model)
-----------------------------------------------------------------------------
-- | Convert a 'URI' to a 'Location'.
uriToLocation :: URI -> Location
uriToLocation :: URI -> Location
uriToLocation URI
uri = 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)
  }
-----------------------------------------------------------------------------