-----------------------------------------------------------------------------
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE DefaultSignatures          #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE DataKinds                  #-}
{-# 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
--
-- This module introduces a @Router@ that produces "correct-by-construction" URL
-- encoding and decoding from any Haskell algebraic data type. This @Router@ can be used
-- in conjunction with @uriSub@ or @routeSub@ to perform client-side routing. Further
-- it also supports the construction of type-safe links in any @View model action@ via
-- the @href_@ function exported from this module.
--
-- This module can be used in two ways, one is the manual construction of a @Router@
-- as seen below.
--
-- @
--
-- data Route = Widget Int
--    deriving (Show, Eq)
--
-- instance Router Route where
--   routeParser = routes [ Widget \<$\> (path "widget" *\> capture) ]
--   fromRoute (Widget value) = [ toPath "widget", toCapture value ]
--
-- main :: IO ()
-- main = print (runRouter "/widget/10" router)
--
-- > Right (Widget "widget" 10)
-- @
--
-- The second way is using the @Generic@ deriving mechanism. This should ensure that
--
-- @
--
-- {-# LANGUAGE DerivingStrategies #-}
-- {-# LANGUAGE DeriveAnyClass     #-}
-- {-# LANGUAGE DeriveGeneric      #-}
--
-- data Route
--  = About
--  | Home
--  | Widget (Capture "thing" Int) (Path "foo") (Capture "other" MisoString) (QueryParam "bar" Int)
--  deriving stock (Generic, Show)
--  deriving anyclass Router
-- @
--
-- The @Generic@ deriving works by converting the constructor name to a path so
--
-- > test :: Either RoutingError Route
-- > test = toRoute "/widget/23/foo/okay?bar=0"
--
-- Decodes as
--
-- > Right (Widget (Capture 23) (Path "foo") (Capture "okay") (QueryParam (Just 0)))
--
-- The order of `Capture` and `Path` matters when defined on your sum type. The order of `QueryParam` and `QueryFlag` does not.
--
-- The router is "reversible" which means it can produce type-safe links using the `href_` function.
--
-- > prettyRoute $ Widget (Capture 23) (Path ("foo")) (Capture ("okay")) (QueryParam (Just 0))
-- > "/widget/23/foo/okay?bar=0"
--
-- This can be used in conjunction with the @href_@ field below to embed type safe links into 'miso' @View model action@ code.
--
-- > button_ [ Miso.Router.href_ (Widget 10) ] [ "click me" ]
--
-- Note: the `Index` constructor is name special, it used to encode the `"/"` path.
--
-- @
--
-- data Route = Index
--   deriving stock (Show, Eq)
--   deriving anyclass (Router)
--
-- main :: IO ()
-- main = print (fromRoute Index)
--
-- -- "/"
-- @
--
-- Lastly, camel-case constructors only use the first hump of the camel.
--
-- @
--
-- data Route = Index | FooBar
--   deriving anyclass Router
--   deriving stock (Show, Eq, Generic)
--
-- main :: IO ()
-- main = print (prettyRoute FooBar)
--
-- "/foo"
-- @
--
-----------------------------------------------------------------------------
module Miso.Router
  ( -- ** Classes
    Router (..)
    -- ** Types
  , Capture (..)
  , Path (..)
  , QueryParam (..)
  , QueryFlag (..)
  , Token (..)
  , URI (..)
    -- ** Errors
  , RoutingError (..)
    -- ** Functions
  , parseURI
  , prettyURI
  , prettyQueryString
    -- ** Manual Routing
  , runRouter
  , routes
    -- ** Construction
  , toQueryFlag
  , toQueryParam
  , toCapture
  , toPath
  , emptyURI
    -- ** Parser combinators
  , queryFlag
  , queryParam
  , capture
  , path
  ) where
-----------------------------------------------------------------------------
import qualified Data.Map.Strict as M
import           Data.Maybe
import           Data.Functor
import           Data.Proxy
import           Data.Char
import qualified Data.Char as C
import           Data.String
import           Control.Applicative
import           Control.Monad
import           GHC.Generics
import           GHC.TypeLits
-----------------------------------------------------------------------------
import           Miso.Types hiding (model)
import           Miso.Util
import qualified Miso.Html.Property as P
import           Miso.Util.Parser hiding (NoParses)
import qualified Miso.Util.Lexer as L
import           Miso.Util.Lexer (Lexer)
import           Miso.String (ToMisoString, FromMisoString, fromMisoStringEither)
import qualified Miso.String as MS
-----------------------------------------------------------------------------
newtype Capture sym a = Capture a
  deriving stock ((forall x. Capture sym a -> Rep (Capture sym a) x)
-> (forall x. Rep (Capture sym a) x -> Capture sym a)
-> Generic (Capture sym a)
forall x. Rep (Capture sym a) x -> Capture sym a
forall x. Capture sym a -> Rep (Capture sym a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (sym :: k) a x. Rep (Capture sym a) x -> Capture sym a
forall k (sym :: k) a x. Capture sym a -> Rep (Capture sym a) x
$cfrom :: forall k (sym :: k) a x. Capture sym a -> Rep (Capture sym a) x
from :: forall x. Capture sym a -> Rep (Capture sym a) x
$cto :: forall k (sym :: k) a x. Rep (Capture sym a) x -> Capture sym a
to :: forall x. Rep (Capture sym a) x -> Capture sym a
Generic, Capture sym a -> Capture sym a -> Bool
(Capture sym a -> Capture sym a -> Bool)
-> (Capture sym a -> Capture sym a -> Bool) -> Eq (Capture sym a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (sym :: k) a.
Eq a =>
Capture sym a -> Capture sym a -> Bool
$c== :: forall k (sym :: k) a.
Eq a =>
Capture sym a -> Capture sym a -> Bool
== :: Capture sym a -> Capture sym a -> Bool
$c/= :: forall k (sym :: k) a.
Eq a =>
Capture sym a -> Capture sym a -> Bool
/= :: Capture sym a -> Capture sym a -> Bool
Eq, Int -> Capture sym a -> ShowS
[Capture sym a] -> ShowS
Capture sym a -> [Char]
(Int -> Capture sym a -> ShowS)
-> (Capture sym a -> [Char])
-> ([Capture sym a] -> ShowS)
-> Show (Capture sym a)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall k (sym :: k) a. Show a => Int -> Capture sym a -> ShowS
forall k (sym :: k) a. Show a => [Capture sym a] -> ShowS
forall k (sym :: k) a. Show a => Capture sym a -> [Char]
$cshowsPrec :: forall k (sym :: k) a. Show a => Int -> Capture sym a -> ShowS
showsPrec :: Int -> Capture sym a -> ShowS
$cshow :: forall k (sym :: k) a. Show a => Capture sym a -> [Char]
show :: Capture sym a -> [Char]
$cshowList :: forall k (sym :: k) a. Show a => [Capture sym a] -> ShowS
showList :: [Capture sym a] -> ShowS
Show)
  deriving newtype (Capture sym a -> MisoString
(Capture sym a -> MisoString) -> ToMisoString (Capture sym a)
forall str. (str -> MisoString) -> ToMisoString str
forall k (sym :: k) a.
ToMisoString a =>
Capture sym a -> MisoString
$ctoMisoString :: forall k (sym :: k) a.
ToMisoString a =>
Capture sym a -> MisoString
toMisoString :: Capture sym a -> MisoString
ToMisoString, MisoString -> Either [Char] (Capture sym a)
(MisoString -> Either [Char] (Capture sym a))
-> FromMisoString (Capture sym a)
forall t. (MisoString -> Either [Char] t) -> FromMisoString t
forall k (sym :: k) a.
FromMisoString a =>
MisoString -> Either [Char] (Capture sym a)
$cfromMisoStringEither :: forall k (sym :: k) a.
FromMisoString a =>
MisoString -> Either [Char] (Capture sym a)
fromMisoStringEither :: MisoString -> Either [Char] (Capture sym a)
FromMisoString)
-----------------------------------------------------------------------------
newtype Path (path :: Symbol) = Path MisoString
  deriving ((forall x. Path path -> Rep (Path path) x)
-> (forall x. Rep (Path path) x -> Path path)
-> Generic (Path path)
forall x. Rep (Path path) x -> Path path
forall x. Path path -> Rep (Path path) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (path :: Symbol) x. Rep (Path path) x -> Path path
forall (path :: Symbol) x. Path path -> Rep (Path path) x
$cfrom :: forall (path :: Symbol) x. Path path -> Rep (Path path) x
from :: forall x. Path path -> Rep (Path path) x
$cto :: forall (path :: Symbol) x. Rep (Path path) x -> Path path
to :: forall x. Rep (Path path) x -> Path path
Generic, Path path -> Path path -> Bool
(Path path -> Path path -> Bool)
-> (Path path -> Path path -> Bool) -> Eq (Path path)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (path :: Symbol). Path path -> Path path -> Bool
$c== :: forall (path :: Symbol). Path path -> Path path -> Bool
== :: Path path -> Path path -> Bool
$c/= :: forall (path :: Symbol). Path path -> Path path -> Bool
/= :: Path path -> Path path -> Bool
Eq, Int -> Path path -> ShowS
[Path path] -> ShowS
Path path -> [Char]
(Int -> Path path -> ShowS)
-> (Path path -> [Char])
-> ([Path path] -> ShowS)
-> Show (Path path)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall (path :: Symbol). Int -> Path path -> ShowS
forall (path :: Symbol). [Path path] -> ShowS
forall (path :: Symbol). Path path -> [Char]
$cshowsPrec :: forall (path :: Symbol). Int -> Path path -> ShowS
showsPrec :: Int -> Path path -> ShowS
$cshow :: forall (path :: Symbol). Path path -> [Char]
show :: Path path -> [Char]
$cshowList :: forall (path :: Symbol). [Path path] -> ShowS
showList :: [Path path] -> ShowS
Show)
  deriving newtype (Path path -> MisoString
(Path path -> MisoString) -> ToMisoString (Path path)
forall str. (str -> MisoString) -> ToMisoString str
forall (path :: Symbol). Path path -> MisoString
$ctoMisoString :: forall (path :: Symbol). Path path -> MisoString
toMisoString :: Path path -> MisoString
ToMisoString, [Char] -> Path path
([Char] -> Path path) -> IsString (Path path)
forall a. ([Char] -> a) -> IsString a
forall (path :: Symbol). [Char] -> Path path
$cfromString :: forall (path :: Symbol). [Char] -> Path path
fromString :: [Char] -> Path path
IsString)
-----------------------------------------------------------------------------
newtype QueryFlag (path :: Symbol) = QueryFlag Bool
  deriving ((forall x. QueryFlag path -> Rep (QueryFlag path) x)
-> (forall x. Rep (QueryFlag path) x -> QueryFlag path)
-> Generic (QueryFlag path)
forall x. Rep (QueryFlag path) x -> QueryFlag path
forall x. QueryFlag path -> Rep (QueryFlag path) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (path :: Symbol) x. Rep (QueryFlag path) x -> QueryFlag path
forall (path :: Symbol) x. QueryFlag path -> Rep (QueryFlag path) x
$cfrom :: forall (path :: Symbol) x. QueryFlag path -> Rep (QueryFlag path) x
from :: forall x. QueryFlag path -> Rep (QueryFlag path) x
$cto :: forall (path :: Symbol) x. Rep (QueryFlag path) x -> QueryFlag path
to :: forall x. Rep (QueryFlag path) x -> QueryFlag path
Generic, QueryFlag path -> QueryFlag path -> Bool
(QueryFlag path -> QueryFlag path -> Bool)
-> (QueryFlag path -> QueryFlag path -> Bool)
-> Eq (QueryFlag path)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (path :: Symbol). QueryFlag path -> QueryFlag path -> Bool
$c== :: forall (path :: Symbol). QueryFlag path -> QueryFlag path -> Bool
== :: QueryFlag path -> QueryFlag path -> Bool
$c/= :: forall (path :: Symbol). QueryFlag path -> QueryFlag path -> Bool
/= :: QueryFlag path -> QueryFlag path -> Bool
Eq, Int -> QueryFlag path -> ShowS
[QueryFlag path] -> ShowS
QueryFlag path -> [Char]
(Int -> QueryFlag path -> ShowS)
-> (QueryFlag path -> [Char])
-> ([QueryFlag path] -> ShowS)
-> Show (QueryFlag path)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall (path :: Symbol). Int -> QueryFlag path -> ShowS
forall (path :: Symbol). [QueryFlag path] -> ShowS
forall (path :: Symbol). QueryFlag path -> [Char]
$cshowsPrec :: forall (path :: Symbol). Int -> QueryFlag path -> ShowS
showsPrec :: Int -> QueryFlag path -> ShowS
$cshow :: forall (path :: Symbol). QueryFlag path -> [Char]
show :: QueryFlag path -> [Char]
$cshowList :: forall (path :: Symbol). [QueryFlag path] -> ShowS
showList :: [QueryFlag path] -> ShowS
Show)
-----------------------------------------------------------------------------
newtype QueryParam (path :: Symbol) a = QueryParam (Maybe a)
  deriving ((forall x. QueryParam path a -> Rep (QueryParam path a) x)
-> (forall x. Rep (QueryParam path a) x -> QueryParam path a)
-> Generic (QueryParam path a)
forall x. Rep (QueryParam path a) x -> QueryParam path a
forall x. QueryParam path a -> Rep (QueryParam path a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (path :: Symbol) a x.
Rep (QueryParam path a) x -> QueryParam path a
forall (path :: Symbol) a x.
QueryParam path a -> Rep (QueryParam path a) x
$cfrom :: forall (path :: Symbol) a x.
QueryParam path a -> Rep (QueryParam path a) x
from :: forall x. QueryParam path a -> Rep (QueryParam path a) x
$cto :: forall (path :: Symbol) a x.
Rep (QueryParam path a) x -> QueryParam path a
to :: forall x. Rep (QueryParam path a) x -> QueryParam path a
Generic, QueryParam path a -> QueryParam path a -> Bool
(QueryParam path a -> QueryParam path a -> Bool)
-> (QueryParam path a -> QueryParam path a -> Bool)
-> Eq (QueryParam path a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (path :: Symbol) a.
Eq a =>
QueryParam path a -> QueryParam path a -> Bool
$c== :: forall (path :: Symbol) a.
Eq a =>
QueryParam path a -> QueryParam path a -> Bool
== :: QueryParam path a -> QueryParam path a -> Bool
$c/= :: forall (path :: Symbol) a.
Eq a =>
QueryParam path a -> QueryParam path a -> Bool
/= :: QueryParam path a -> QueryParam path a -> Bool
Eq, Int -> QueryParam path a -> ShowS
[QueryParam path a] -> ShowS
QueryParam path a -> [Char]
(Int -> QueryParam path a -> ShowS)
-> (QueryParam path a -> [Char])
-> ([QueryParam path a] -> ShowS)
-> Show (QueryParam path a)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall (path :: Symbol) a.
Show a =>
Int -> QueryParam path a -> ShowS
forall (path :: Symbol) a. Show a => [QueryParam path a] -> ShowS
forall (path :: Symbol) a. Show a => QueryParam path a -> [Char]
$cshowsPrec :: forall (path :: Symbol) a.
Show a =>
Int -> QueryParam path a -> ShowS
showsPrec :: Int -> QueryParam path a -> ShowS
$cshow :: forall (path :: Symbol) a. Show a => QueryParam path a -> [Char]
show :: QueryParam path a -> [Char]
$cshowList :: forall (path :: Symbol) a. Show a => [QueryParam path a] -> ShowS
showList :: [QueryParam path a] -> ShowS
Show)
-----------------------------------------------------------------------------
instance (ToMisoString a, KnownSymbol path) => ToMisoString (QueryParam path a) where
  toMisoString :: QueryParam path a -> MisoString
toMisoString (QueryParam Maybe a
maybeVal) =
    MisoString
-> (MisoString -> MisoString) -> Maybe MisoString -> MisoString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe MisoString
forall a. Monoid a => a
mempty (\MisoString
param -> MisoString
"?" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
param MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"=" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
val) (a -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (a -> MisoString) -> Maybe a -> Maybe MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
maybeVal)
      where
        val :: MisoString
val = [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms ([Char] -> MisoString) -> [Char] -> MisoString
forall a b. (a -> b) -> a -> b
$ Proxy path -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @path)
-----------------------------------------------------------------------------
instance (FromMisoString a, KnownSymbol path) => FromMisoString (QueryParam path a) where
  fromMisoStringEither :: MisoString -> Either [Char] (QueryParam path a)
fromMisoStringEither MisoString
x =
    case forall t. FromMisoString t => MisoString -> Either [Char] t
fromMisoStringEither @a MisoString
x of
      Right a
r -> QueryParam path a -> Either [Char] (QueryParam path a)
forall a b. b -> Either a b
Right (QueryParam path a -> Either [Char] (QueryParam path a))
-> QueryParam path a -> Either [Char] (QueryParam path a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> QueryParam path a
forall (path :: Symbol) a. Maybe a -> QueryParam path a
QueryParam (a -> Maybe a
forall a. a -> Maybe a
Just a
r)
      Left [Char]
v -> [Char] -> Either [Char] (QueryParam path a)
forall a b. a -> Either a b
Left [Char]
v
-----------------------------------------------------------------------------
instance KnownSymbol name => ToMisoString (QueryFlag name) where
  toMisoString :: QueryFlag name -> MisoString
toMisoString = \case
    QueryFlag Bool
True ->
      MisoString
"?" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name))
    QueryFlag Bool
False ->
      MisoString
forall a. Monoid a => a
mempty
-----------------------------------------------------------------------------
data Token
  = QueryParamTokens [(MisoString, MisoString)]
  | QueryParamToken MisoString MisoString
  | QueryFlagToken MisoString
  | CaptureOrPathToken MisoString
  | FragmentToken MisoString
  | IndexToken
  deriving (Int -> Token -> ShowS
[Token] -> ShowS
Token -> [Char]
(Int -> Token -> ShowS)
-> (Token -> [Char]) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> [Char]
show :: Token -> [Char]
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show, Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq)
-----------------------------------------------------------------------------
toQueryParam :: ToMisoString s => MisoString -> s -> Token
toQueryParam :: forall s. ToMisoString s => MisoString -> s -> Token
toQueryParam MisoString
k s
v = MisoString -> MisoString -> Token
QueryParamToken MisoString
k (s -> MisoString
forall str. ToMisoString str => str -> MisoString
ms s
v)
-----------------------------------------------------------------------------
toQueryFlag :: MisoString -> Token
toQueryFlag :: MisoString -> Token
toQueryFlag = MisoString -> Token
QueryFlagToken
-----------------------------------------------------------------------------
toCapture :: ToMisoString string => string -> Token
toCapture :: forall string. ToMisoString string => string -> Token
toCapture = MisoString -> Token
CaptureOrPathToken (MisoString -> Token) -> (string -> MisoString) -> string -> Token
forall b c a. (b -> c) -> (a -> b) -> a -> c
. string -> MisoString
forall str. ToMisoString str => str -> MisoString
ms
-----------------------------------------------------------------------------
toPath :: MisoString -> Token
toPath :: MisoString -> Token
toPath = MisoString -> Token
CaptureOrPathToken
-----------------------------------------------------------------------------
-- | Converts a list of @[Token]@ into an actual @URI@.
tokensToURI :: [Token] -> URI
tokensToURI :: [Token] -> URI
tokensToURI [Token]
tokens = URI
  { uriPath :: MisoString
uriPath =
      case [Token]
tokens of
        Token
IndexToken : [Token]
_ -> MisoString
""
        [Token]
_ ->
          MisoString -> [MisoString] -> MisoString
MS.intercalate MisoString
"/"
          [ MisoString
x
          | CaptureOrPathToken MisoString
x <- (Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter Token -> Bool
isPathRelated [Token]
tokens
          ]
  , uriQueryString :: Map MisoString (Maybe MisoString)
uriQueryString =
      [Map MisoString (Maybe MisoString)]
-> Map MisoString (Maybe MisoString)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions
        [ case Token
queryToken of
            QueryFlagToken MisoString
k ->
              MisoString -> Maybe MisoString -> Map MisoString (Maybe MisoString)
forall k a. k -> a -> Map k a
M.singleton MisoString
k Maybe MisoString
forall a. Maybe a
Nothing
            QueryParamTokens [(MisoString, MisoString)]
queryParams_ ->
              [(MisoString, Maybe MisoString)]
-> Map MisoString (Maybe MisoString)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
              [ (MisoString
k, MisoString -> Maybe MisoString
forall a. a -> Maybe a
Just MisoString
v)
              | (MisoString
k,MisoString
v) <- [(MisoString, MisoString)]
queryParams_
              ]
            QueryParamToken MisoString
k MisoString
v ->
              MisoString -> Maybe MisoString -> Map MisoString (Maybe MisoString)
forall k a. k -> a -> Map k a
M.singleton MisoString
k (MisoString -> Maybe MisoString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MisoString
v)
            Token
_ ->
              Map MisoString (Maybe MisoString)
forall a. Monoid a => a
mempty
        | Token
queryToken <- (Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter Token -> Bool
isQuery [Token]
tokens
        ]
  , uriFragment :: MisoString
uriFragment =
      (Token -> MisoString) -> [Token] -> MisoString
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Token -> MisoString
forall str. ToMisoString str => str -> MisoString
ms ((Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter Token -> Bool
isFragment [Token]
tokens)
  } where
      isFragment :: Token -> Bool
isFragment = \case
        FragmentToken{} -> Bool
True
        Token
_ -> Bool
False
      isQuery :: Token -> Bool
isQuery = \case
        QueryFlagToken{} -> Bool
True
        QueryParamToken{} -> Bool
True
        Token
_ -> Bool
False
      isPathRelated :: Token -> Bool
isPathRelated = \case
        CaptureOrPathToken {} -> Bool
True
        IndexToken {} -> Bool
True
        Token
_ -> Bool
False
-----------------------------------------------------------------------------
instance ToMisoString Token where
  toMisoString :: Token -> MisoString
toMisoString = \case
    CaptureOrPathToken MisoString
x -> MisoString
"/" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
x
    QueryFlagToken MisoString
x -> MisoString
"?" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
x
    FragmentToken MisoString
x -> MisoString
"#" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
x
    QueryParamTokens [(MisoString, MisoString)]
params ->
      MisoString
"?" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString -> [MisoString] -> MisoString
MS.intercalate MisoString
"&"
        [ MisoString
key MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"=" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
value
        | (MisoString
key, MisoString
value) <- [(MisoString, MisoString)]
params
        ]
    QueryParamToken MisoString
k MisoString
v ->
      MisoString
"?" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
k MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"=" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
v
    Token
IndexToken -> MisoString
"/"
-----------------------------------------------------------------------------
data RoutingError
  = ParseError MisoString [Token]
  | AmbiguousParse MisoString [Token]
  | LexError MisoString MisoString
  | LexErrorEOF MisoString
  | NoParses MisoString
  deriving (Int -> RoutingError -> ShowS
[RoutingError] -> ShowS
RoutingError -> [Char]
(Int -> RoutingError -> ShowS)
-> (RoutingError -> [Char])
-> ([RoutingError] -> ShowS)
-> Show RoutingError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RoutingError -> ShowS
showsPrec :: Int -> RoutingError -> ShowS
$cshow :: RoutingError -> [Char]
show :: RoutingError -> [Char]
$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)
-----------------------------------------------------------------------------
type RouteParser = ParserT URI [Token] []
-----------------------------------------------------------------------------
capture :: FromMisoString value => RouteParser value
capture :: forall value. FromMisoString value => RouteParser value
capture = do
  CaptureOrPathToken capture_ <- RouteParser Token
captureOrPathToken
  case fromMisoStringEither capture_ of
    Left [Char]
msg -> [Char] -> ParserT URI [Token] [] value
forall a. [Char] -> ParserT URI [Token] [] a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (MisoString -> [Char]
forall a. FromMisoString a => MisoString -> a
fromMisoString ([Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms [Char]
msg))
    Right value
token -> value -> ParserT URI [Token] [] value
forall a. a -> ParserT URI [Token] [] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure value
token
-----------------------------------------------------------------------------
path :: MisoString -> RouteParser MisoString
path :: MisoString -> RouteParser MisoString
path MisoString
specified = do
  CaptureOrPathToken parsed <- RouteParser Token
captureOrPathToken
  when (specified /= parsed) (fail "path")
  pure specified
-----------------------------------------------------------------------------
index :: MisoString -> RouteParser MisoString
index :: MisoString -> RouteParser MisoString
index MisoString
specified = do
  Token -> RouteParser MisoString
IndexToken <- RouteParser Token
indexToken
  when (specified /= "index") (fail "index")
  pure "/"
-----------------------------------------------------------------------------
parseURI :: MisoString -> Either MisoString URI
parseURI :: MisoString -> Either MisoString URI
parseURI MisoString
txt =
  case MisoString -> Either LexerError [Token]
lexTokens MisoString
txt of
    Left (L.LexerError MisoString
err Location
_) -> MisoString -> Either MisoString URI
forall a b. a -> Either a b
Left MisoString
err
    Left (L.UnexpectedEOF Location
eof) -> MisoString -> Either MisoString URI
forall a b. a -> Either a b
Left (MisoString
"EOF: " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Location -> [Char]
forall a. Show a => a -> [Char]
show Location
eof))
    Right [Token]
tokens -> URI -> Either MisoString URI
forall a b. b -> Either a b
Right ([Token] -> URI
tokensToURI [Token]
tokens)
-----------------------------------------------------------------------------
class Router route where
  fromRoute :: route -> [Token]
  default fromRoute :: (Generic route, GRouter (Rep route)) => route -> [Token]
  fromRoute = Rep route (ZonkAny 0) -> [Token]
forall route. Rep route route -> [Token]
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
f route -> [Token]
gFromRoute (Rep route (ZonkAny 0) -> [Token])
-> (route -> Rep route (ZonkAny 0)) -> route -> [Token]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. route -> Rep route (ZonkAny 0)
forall x. route -> Rep route x
forall a x. Generic a => a -> Rep a x
from

  toURI :: route -> URI
  toURI = [Token] -> URI
tokensToURI ([Token] -> URI) -> (route -> [Token]) -> route -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. route -> [Token]
forall route. Router route => route -> [Token]
fromRoute

  route :: URI -> Either RoutingError route
  route = MisoString -> Either RoutingError route
forall route.
Router route =>
MisoString -> Either RoutingError route
toRoute (MisoString -> Either RoutingError route)
-> (URI -> MisoString) -> URI -> Either RoutingError route
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> MisoString
prettyURI

  href_ :: route -> Attribute action
  href_ = MisoString -> Attribute action
forall action. MisoString -> Attribute action
P.href_ (MisoString -> Attribute action)
-> (route -> MisoString) -> route -> Attribute action
forall b c a. (b -> c) -> (a -> b) -> a -> c
. route -> MisoString
forall route. Router route => route -> MisoString
prettyRoute

  prettyRoute :: route -> MisoString
  prettyRoute = URI -> MisoString
prettyURI (URI -> MisoString) -> (route -> URI) -> route -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> URI
tokensToURI ([Token] -> URI) -> (route -> [Token]) -> route -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. route -> [Token]
forall route. Router route => route -> [Token]
fromRoute

  dumpURI :: route -> MisoString
  dumpURI = [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms ([Char] -> MisoString) -> (route -> [Char]) -> route -> MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> [Char]
forall a. Show a => a -> [Char]
show (URI -> [Char]) -> (route -> URI) -> route -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Token] -> URI
tokensToURI ([Token] -> URI) -> (route -> [Token]) -> route -> URI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. route -> [Token]
forall route. Router route => route -> [Token]
fromRoute

  toRoute :: MisoString -> Either RoutingError route
  toRoute MisoString
input = MisoString -> RouteParser route -> Either RoutingError route
forall a. MisoString -> RouteParser a -> Either RoutingError a
parseRoute MisoString
input RouteParser route
forall route. Router route => RouteParser route
routeParser

  routeParser :: RouteParser route
  default routeParser :: (Generic route, GRouter (Rep route)) => RouteParser route
  routeParser = Rep route (ZonkAny 1) -> route
forall a x. Generic a => Rep a x -> a
forall x. Rep route x -> route
to (Rep route (ZonkAny 1) -> route)
-> ParserT URI [Token] [] (Rep route (ZonkAny 1))
-> RouteParser route
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT URI [Token] [] (Rep route (ZonkAny 1))
forall route. RouteParser (Rep route route)
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
RouteParser (f route)
gRouteParser
-----------------------------------------------------------------------------
-- | Smart constructor for building a @RouteParser@
--
-- @
--
-- data Route = Widget MisoString Int
--
-- instance Router Route where
--   routeParser = routes [ Widget <$> path "widget" <*> capture ]
--   fromRoute (Widget path value) = [ toPath path, toCapture value ]
--
-- router :: Router router => RouteParser router
-- router = routes [ Widget <$> path "widget" <*> capture ]
--
-- > Right (Widget "widget" 10)
-- @
--
-----------------------------------------------------------------------------
runRouter :: MisoString -> RouteParser route -> Either RoutingError route
runRouter :: forall a. MisoString -> RouteParser a -> Either RoutingError a
runRouter = MisoString -> RouteParser route -> Either RoutingError route
forall a. MisoString -> RouteParser a -> Either RoutingError a
parseRoute
-----------------------------------------------------------------------------
routes :: [ RouteParser route ] -> RouteParser route
routes :: forall route. [RouteParser route] -> RouteParser route
routes = (RouteParser route -> RouteParser route -> RouteParser route)
-> RouteParser route -> [RouteParser route] -> RouteParser route
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RouteParser route -> RouteParser route -> RouteParser route
forall a.
ParserT URI [Token] [] a
-> ParserT URI [Token] [] a -> ParserT URI [Token] [] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) RouteParser route
forall a. ParserT URI [Token] [] a
forall (f :: * -> *) a. Alternative f => f a
empty
-----------------------------------------------------------------------------
prettyURI :: URI -> MisoString
prettyURI :: URI -> MisoString
prettyURI uri :: URI
uri@URI {Map MisoString (Maybe MisoString)
MisoString
uriPath :: URI -> MisoString
uriQueryString :: URI -> Map MisoString (Maybe MisoString)
uriFragment :: URI -> MisoString
uriPath :: MisoString
uriFragment :: MisoString
uriQueryString :: Map MisoString (Maybe MisoString)
..} = MisoString
"/" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
uriPath MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> URI -> MisoString
prettyQueryString URI
uri MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
uriFragment
-----------------------------------------------------------------------------
prettyQueryString :: URI -> MisoString
prettyQueryString :: URI -> MisoString
prettyQueryString URI {Map MisoString (Maybe MisoString)
MisoString
uriPath :: URI -> MisoString
uriQueryString :: URI -> Map MisoString (Maybe MisoString)
uriFragment :: URI -> MisoString
uriPath :: MisoString
uriFragment :: MisoString
uriQueryString :: Map MisoString (Maybe MisoString)
..} = MisoString
queries MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
flags
  where
    queries :: MisoString
queries =
      [MisoString] -> MisoString
MS.concat
      [ MisoString
"?" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<>
        MisoString -> [MisoString] -> MisoString
MS.intercalate MisoString
"&"
        [ MisoString
k MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
"=" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
v
        | (MisoString
k, Just MisoString
v) <- Map MisoString (Maybe MisoString)
-> [(MisoString, Maybe MisoString)]
forall k a. Map k a -> [(k, a)]
M.toList Map MisoString (Maybe MisoString)
uriQueryString
        ]
      | (Maybe MisoString -> Bool) -> [Maybe MisoString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Maybe MisoString -> Bool
forall a. Maybe a -> Bool
isJust (Map MisoString (Maybe MisoString) -> [Maybe MisoString]
forall k a. Map k a -> [a]
M.elems Map MisoString (Maybe MisoString)
uriQueryString)
      ]
    flags :: MisoString
flags = [MisoString] -> MisoString
forall a. Monoid a => [a] -> a
mconcat
        [ MisoString
"?" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> MisoString
k
        | (MisoString
k, Maybe MisoString
Nothing) <- Map MisoString (Maybe MisoString)
-> [(MisoString, Maybe MisoString)]
forall k a. Map k a -> [(k, a)]
M.toList Map MisoString (Maybe MisoString)
uriQueryString
        ]
-----------------------------------------------------------------------------
class GRouter f where
  gFromRoute :: f route -> [Token]
  gRouteParser :: RouteParser (f route)
-----------------------------------------------------------------------------
instance GRouter next => GRouter (D1 m next) where
  gFromRoute :: forall (route :: k). D1 m next route -> [Token]
gFromRoute (M1 next route
x) = next route -> [Token]
forall (route :: k). next route -> [Token]
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
f route -> [Token]
gFromRoute next route
x
  gRouteParser :: forall (route :: k). RouteParser (D1 m next route)
gRouteParser = next route -> M1 D m next route
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (next route -> M1 D m next route)
-> ParserT URI [Token] [] (next route)
-> ParserT URI [Token] [] (M1 D m next route)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT URI [Token] [] (next route)
forall (route :: k). RouteParser (next route)
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
RouteParser (f route)
gRouteParser
-----------------------------------------------------------------------------
instance (KnownSymbol name, GRouter next) => GRouter (C1 (MetaCons name x y) next) where
  gFromRoute :: forall (route :: k). C1 ('MetaCons name x y) next route -> [Token]
gFromRoute (M1 next route
x) =
    case MisoString
name of
      MisoString
"index" -> [Token
IndexToken]
      MisoString
_ -> MisoString -> Token
CaptureOrPathToken MisoString
name Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: next route -> [Token]
forall (route :: k). next route -> [Token]
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
f route -> [Token]
gFromRoute next route
x
      where
        name :: MisoString
name = [Char] -> MisoString
lowercaseStrip ([Char] -> MisoString) -> [Char] -> MisoString
forall a b. (a -> b) -> a -> b
$ Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name)
  gRouteParser :: forall (route :: k).
RouteParser (C1 ('MetaCons name x y) next route)
gRouteParser = do
    case MisoString
name of
      MisoString
"index" -> do
        RouteParser MisoString -> ParserT URI [Token] [] ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MisoString -> RouteParser MisoString
index MisoString
name)
        next route -> C1 ('MetaCons name x y) next route
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (next route -> C1 ('MetaCons name x y) next route)
-> ParserT URI [Token] [] (next route)
-> RouteParser (C1 ('MetaCons name x y) next route)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT URI [Token] [] (next route)
forall (route :: k). RouteParser (next route)
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
RouteParser (f route)
gRouteParser
      MisoString
_ -> do
        RouteParser MisoString -> ParserT URI [Token] [] ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (MisoString -> RouteParser MisoString
path MisoString
name)
        next route -> C1 ('MetaCons name x y) next route
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (next route -> C1 ('MetaCons name x y) next route)
-> ParserT URI [Token] [] (next route)
-> RouteParser (C1 ('MetaCons name x y) next route)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT URI [Token] [] (next route)
forall (route :: k). RouteParser (next route)
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
RouteParser (f route)
gRouteParser
      where
        name :: MisoString
name = [Char] -> MisoString
lowercaseStrip ([Char] -> MisoString) -> [Char] -> MisoString
forall a b. (a -> b) -> a -> b
$ Proxy name -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name)
-----------------------------------------------------------------------------
instance GRouter next => GRouter (S1 m next) where
  gFromRoute :: forall (route :: k). S1 m next route -> [Token]
gFromRoute (M1 next route
x) = next route -> [Token]
forall (route :: k). next route -> [Token]
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
f route -> [Token]
gFromRoute next route
x
  gRouteParser :: forall (route :: k). RouteParser (S1 m next route)
gRouteParser = next route -> M1 S m next route
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (next route -> M1 S m next route)
-> ParserT URI [Token] [] (next route)
-> ParserT URI [Token] [] (M1 S m next route)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT URI [Token] [] (next route)
forall (route :: k). RouteParser (next route)
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
RouteParser (f route)
gRouteParser
-----------------------------------------------------------------------------
instance {-# OVERLAPS #-} forall path m . KnownSymbol path => GRouter (K1 m (Path path)) where
  gFromRoute :: forall (route :: k). K1 m (Path path) route -> [Token]
gFromRoute (K1 Path path
x) = Token -> [Token]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token -> [Token]) -> Token -> [Token]
forall a b. (a -> b) -> a -> b
$ MisoString -> Token
CaptureOrPathToken (Path path -> MisoString
forall str. ToMisoString str => str -> MisoString
ms Path path
x)
  gRouteParser :: forall (route :: k). RouteParser (K1 m (Path path) route)
gRouteParser = Path path -> K1 m (Path path) route
forall k i c (p :: k). c -> K1 i c p
K1 (MisoString -> Path path
forall (path :: Symbol). MisoString -> Path path
Path MisoString
chunk) K1 m (Path path) route
-> RouteParser MisoString
-> ParserT URI [Token] [] (K1 m (Path path) route)
forall a b.
a -> ParserT URI [Token] [] b -> ParserT URI [Token] [] a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ MisoString -> RouteParser MisoString
path MisoString
chunk
    where
      chunk :: MisoString
chunk = [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms ([Char] -> MisoString) -> [Char] -> MisoString
forall a b. (a -> b) -> a -> b
$ Proxy path -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (Proxy path
forall {k} (t :: k). Proxy t
Proxy :: Proxy path)
-----------------------------------------------------------------------------
instance {-# OVERLAPS #-} (FromMisoString a, ToMisoString a) => GRouter (K1 m (Capture sym a)) where
  gFromRoute :: forall (route :: k). K1 m (Capture sym a) route -> [Token]
gFromRoute (K1 Capture sym a
x) = Token -> [Token]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token -> [Token]) -> Token -> [Token]
forall a b. (a -> b) -> a -> b
$ MisoString -> Token
CaptureOrPathToken (Capture sym a -> MisoString
forall str. ToMisoString str => str -> MisoString
ms Capture sym a
x)
  gRouteParser :: forall (route :: k). RouteParser (K1 m (Capture sym a) route)
gRouteParser = Capture sym a -> K1 m (Capture sym a) route
forall k i c (p :: k). c -> K1 i c p
K1 (Capture sym a -> K1 m (Capture sym a) route)
-> ParserT URI [Token] [] (Capture sym a)
-> ParserT URI [Token] [] (K1 m (Capture sym a) route)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT URI [Token] [] (Capture sym a)
forall value. FromMisoString value => RouteParser value
capture
-----------------------------------------------------------------------------
instance {-# OVERLAPS #-} forall param m a . (ToMisoString a, FromMisoString a, KnownSymbol param) =>
  GRouter (K1 m (QueryParam param a)) where
    gFromRoute :: forall (route :: k). K1 m (QueryParam param a) route -> [Token]
gFromRoute (K1 (QueryParam Maybe a
maybeParam)) =
      case Maybe a
maybeParam of
        Maybe a
Nothing -> []
        Just a
v -> Token -> [Token]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token -> [Token]) -> Token -> [Token]
forall a b. (a -> b) -> a -> b
$ MisoString -> MisoString -> Token
QueryParamToken ([Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Proxy param -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @param))) (a -> MisoString
forall str. ToMisoString str => str -> MisoString
ms a
v)
    gRouteParser :: forall (route :: k). RouteParser (K1 m (QueryParam param a) route)
gRouteParser = QueryParam param a -> K1 m (QueryParam param a) route
forall k i c (p :: k). c -> K1 i c p
K1 (QueryParam param a -> K1 m (QueryParam param a) route)
-> ParserT URI [Token] [] (QueryParam param a)
-> ParserT URI [Token] [] (K1 m (QueryParam param a) route)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT URI [Token] [] (QueryParam param a)
forall (param :: Symbol) a.
(FromMisoString a, KnownSymbol param) =>
RouteParser (QueryParam param a)
queryParam
-----------------------------------------------------------------------------
queryParam
  :: forall param a . (FromMisoString a, KnownSymbol param)
  => RouteParser (QueryParam param a)
queryParam :: forall (param :: Symbol) a.
(FromMisoString a, KnownSymbol param) =>
RouteParser (QueryParam param a)
queryParam = do
  URI {..} <- ParserT URI [Token] [] URI
forall r token. ParserT r token [] r
askParser
  QueryParam <$> do
    case M.lookup (ms (symbolVal (Proxy @param))) uriQueryString of
      Just (Just MisoString
value) ->
        case MisoString -> Either [Char] a
forall t. FromMisoString t => MisoString -> Either [Char] t
fromMisoStringEither MisoString
value of
          Left [Char]
_ -> Maybe a -> ParserT URI [Token] [] (Maybe a)
forall a. a -> ParserT URI [Token] [] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
          Right a
parsed -> Maybe a -> ParserT URI [Token] [] (Maybe a)
forall a. a -> ParserT URI [Token] [] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe a
forall a. a -> Maybe a
Just a
parsed)
      Maybe (Maybe MisoString)
_ -> Maybe a -> ParserT URI [Token] [] (Maybe a)
forall a. a -> ParserT URI [Token] [] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
-----------------------------------------------------------------------------
instance {-# OVERLAPS #-} forall flag m . KnownSymbol flag => GRouter (K1 m (QueryFlag flag)) where
  gFromRoute :: forall (route :: k). K1 m (QueryFlag flag) route -> [Token]
gFromRoute (K1 (QueryFlag Bool
specified))
    | Bool
specified = [ MisoString -> Token
QueryFlagToken MisoString
flag ]
    | Bool
otherwise = []
        where
          flag :: MisoString
flag = [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Proxy flag -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @flag))
  gRouteParser :: forall (route :: k). RouteParser (K1 m (QueryFlag flag) route)
gRouteParser = QueryFlag flag -> K1 m (QueryFlag flag) route
forall k i c (p :: k). c -> K1 i c p
K1 (QueryFlag flag -> K1 m (QueryFlag flag) route)
-> ParserT URI [Token] [] (QueryFlag flag)
-> ParserT URI [Token] [] (K1 m (QueryFlag flag) route)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT URI [Token] [] (QueryFlag flag)
forall (flag :: Symbol).
KnownSymbol flag =>
RouteParser (QueryFlag flag)
queryFlag
-----------------------------------------------------------------------------
queryFlag :: forall flag . KnownSymbol flag => RouteParser (QueryFlag flag)
queryFlag :: forall (flag :: Symbol).
KnownSymbol flag =>
RouteParser (QueryFlag flag)
queryFlag = do
  URI {..} <- ParserT URI [Token] [] URI
forall r token. ParserT r token [] r
askParser
  pure $ QueryFlag $ isJust (M.lookup flag uriQueryString)
    where
      flag :: MisoString
flag = [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms ([Char] -> MisoString) -> [Char] -> MisoString
forall a b. (a -> b) -> a -> b
$ Proxy flag -> [Char]
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal (forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @flag)
-----------------------------------------------------------------------------
instance Router a => GRouter (K1 m a) where
  gFromRoute :: forall (route :: k). K1 m a route -> [Token]
gFromRoute (K1 a
x) = a -> [Token]
forall route. Router route => route -> [Token]
fromRoute a
x
  gRouteParser :: forall (route :: k). RouteParser (K1 m a route)
gRouteParser = a -> K1 m a route
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 m a route)
-> ParserT URI [Token] [] a
-> ParserT URI [Token] [] (K1 m a route)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT URI [Token] [] a
forall route. Router route => RouteParser route
routeParser
-----------------------------------------------------------------------------
instance GRouter U1 where
  gFromRoute :: forall (route :: k). U1 route -> [Token]
gFromRoute U1 route
U1 = []
  gRouteParser :: forall (route :: k). RouteParser (U1 route)
gRouteParser = U1 route -> ParserT URI [Token] [] (U1 route)
forall a. a -> ParserT URI [Token] [] a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 route
forall k (p :: k). U1 p
U1
-----------------------------------------------------------------------------
instance (GRouter left, GRouter right) => GRouter (left :*: right) where
  gFromRoute :: forall (route :: k). (:*:) left right route -> [Token]
gFromRoute (left route
left :*: right route
right) = left route -> [Token]
forall (route :: k). left route -> [Token]
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
f route -> [Token]
gFromRoute left route
left [Token] -> [Token] -> [Token]
forall a. Semigroup a => a -> a -> a
<> right route -> [Token]
forall (route :: k). right route -> [Token]
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
f route -> [Token]
gFromRoute right route
right
  gRouteParser :: forall (route :: k). RouteParser ((:*:) left right route)
gRouteParser = (left route -> right route -> (:*:) left right route)
-> ParserT URI [Token] [] (left route)
-> ParserT URI [Token] [] (right route)
-> ParserT URI [Token] [] ((:*:) left right route)
forall a b c.
(a -> b -> c)
-> ParserT URI [Token] [] a
-> ParserT URI [Token] [] b
-> ParserT URI [Token] [] c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 left route -> right route -> (:*:) left right route
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) ParserT URI [Token] [] (left route)
forall (route :: k). RouteParser (left route)
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
RouteParser (f route)
gRouteParser ParserT URI [Token] [] (right route)
forall (route :: k). RouteParser (right route)
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
RouteParser (f route)
gRouteParser
-----------------------------------------------------------------------------
instance (GRouter left, GRouter right) => GRouter (left :+: right) where
  gFromRoute :: forall (route :: k). (:+:) left right route -> [Token]
gFromRoute = \case
    L1 left route
m1 -> left route -> [Token]
forall (route :: k). left route -> [Token]
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
f route -> [Token]
gFromRoute left route
m1
    R1 right route
m1 -> right route -> [Token]
forall (route :: k). right route -> [Token]
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
f route -> [Token]
gFromRoute right route
m1
  gRouteParser :: forall (route :: k). RouteParser ((:+:) left right route)
gRouteParser = (ParserT URI [Token] [] ((:+:) left right route)
 -> ParserT URI [Token] [] ((:+:) left right route)
 -> ParserT URI [Token] [] ((:+:) left right route))
-> ParserT URI [Token] [] ((:+:) left right route)
-> [ParserT URI [Token] [] ((:+:) left right route)]
-> ParserT URI [Token] [] ((:+:) left right route)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ParserT URI [Token] [] ((:+:) left right route)
-> ParserT URI [Token] [] ((:+:) left right route)
-> ParserT URI [Token] [] ((:+:) left right route)
forall a.
ParserT URI [Token] [] a
-> ParserT URI [Token] [] a -> ParserT URI [Token] [] a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) ParserT URI [Token] [] ((:+:) left right route)
forall a. ParserT URI [Token] [] a
forall (f :: * -> *) a. Alternative f => f a
empty
    [ left route -> (:+:) left right route
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (left route -> (:+:) left right route)
-> ParserT URI [Token] [] (left route)
-> ParserT URI [Token] [] ((:+:) left right route)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT URI [Token] [] (left route)
forall (route :: k). RouteParser (left route)
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
RouteParser (f route)
gRouteParser
    , right route -> (:+:) left right route
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (right route -> (:+:) left right route)
-> ParserT URI [Token] [] (right route)
-> ParserT URI [Token] [] ((:+:) left right route)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT URI [Token] [] (right route)
forall (route :: k). RouteParser (right route)
forall {k} (f :: k -> *) (route :: k).
GRouter f =>
RouteParser (f route)
gRouteParser
    ]
-----------------------------------------------------------------------------
captureOrPathToken :: RouteParser Token
captureOrPathToken :: RouteParser Token
captureOrPathToken = (Token -> Bool) -> RouteParser Token
forall a r. (a -> Bool) -> ParserT r [a] [] a
satisfy ((Token -> Bool) -> RouteParser Token)
-> (Token -> Bool) -> RouteParser Token
forall a b. (a -> b) -> a -> b
$ \case
  CaptureOrPathToken {} -> Bool
True
  Token
_ -> Bool
False
-----------------------------------------------------------------------------
indexToken :: RouteParser Token
indexToken :: RouteParser Token
indexToken = (Token -> Bool) -> RouteParser Token
forall a r. (a -> Bool) -> ParserT r [a] [] a
satisfy ((Token -> Bool) -> RouteParser Token)
-> (Token -> Bool) -> RouteParser Token
forall a b. (a -> b) -> a -> b
$ \case
  IndexToken {} -> Bool
True
  Token
_ -> Bool
False
-----------------------------------------------------------------------------
uriLexer :: Lexer [Token]
uriLexer :: Lexer [Token]
uriLexer = do
  tokens <- Lexer Token -> Lexer [Token]
forall a. Lexer a -> Lexer [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Lexer Token
lexer
  void $ optional (L.char '/')
  pure (postProcess tokens)
    where
      postProcess :: [Token] -> [Token]
      postProcess :: [Token] -> [Token]
postProcess = (Token -> [Token]) -> [Token] -> [Token]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Token -> [Token]) -> [Token] -> [Token])
-> (Token -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$ \case
        QueryParamTokens [(MisoString, MisoString)]
queryParams_ ->
          [ MisoString -> MisoString -> Token
QueryParamToken MisoString
k MisoString
v
          | (MisoString
k,MisoString
v) <- [(MisoString, MisoString)]
queryParams_
          ]
        Token
x -> Token -> [Token]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Token
x
      lexer :: Lexer Token
lexer = [Lexer Token] -> Lexer Token
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum
        [ Lexer Token
queryFlagLexer
        , Lexer Token
captureOrPathLexer
        , Lexer Token
queryParamLexer
        , Lexer Token
fragmentLexer
        , Lexer Token
indexLexer
        ] where
            indexLexer :: Lexer Token
indexLexer =
              Token
IndexToken Token -> Lexer Char -> Lexer Token
forall a b. a -> Lexer b -> Lexer a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Lexer Char
L.char Char
'/'
            captureOrPathLexer :: Lexer Token
captureOrPathLexer = do
              Lexer Char -> Lexer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Lexer Char
L.char Char
'/')
              MisoString -> Token
CaptureOrPathToken (MisoString -> Token) -> Lexer MisoString -> Lexer Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer MisoString
chars
            fragmentLexer :: Lexer Token
fragmentLexer = do
              Lexer Char -> Lexer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Lexer Char
L.char Char
'#')
              MisoString -> Token
FragmentToken (MisoString -> Token) -> Lexer MisoString -> Lexer Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer MisoString
chars
            queryFlagLexer :: Lexer Token
queryFlagLexer = do
              Lexer Char -> Lexer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Lexer Char
L.char Char
'?')
              MisoString -> Token
QueryFlagToken (MisoString -> Token) -> Lexer MisoString -> Lexer Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer MisoString
chars
            queryParamLexer :: Lexer Token
queryParamLexer = [(MisoString, MisoString)] -> Token
QueryParamTokens ([(MisoString, MisoString)] -> Token)
-> Lexer [(MisoString, MisoString)] -> Lexer Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
              Lexer Char -> Lexer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> Lexer Char
L.char Char
'?')
              Lexer Char
-> Lexer (MisoString, MisoString)
-> Lexer [(MisoString, MisoString)]
forall (m :: * -> *) sep a. Alternative m => m sep -> m a -> m [a]
sepBy (Char -> Lexer Char
L.char Char
'&') (Lexer (MisoString, MisoString)
 -> Lexer [(MisoString, MisoString)])
-> Lexer (MisoString, MisoString)
-> Lexer [(MisoString, MisoString)]
forall a b. (a -> b) -> a -> b
$ do
                key <- Lexer MisoString
chars
                void (L.char '=')
                value <- chars
                pure (key, value)
-----------------------------------------------------------------------------
chars :: Lexer MisoString
chars :: Lexer MisoString
chars = ([Char] -> MisoString) -> Lexer [Char] -> Lexer MisoString
forall a b. (a -> b) -> Lexer a -> Lexer b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Lexer [Char] -> Lexer MisoString)
-> (Lexer Char -> Lexer [Char]) -> Lexer Char -> Lexer MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Char -> Lexer [Char]
forall a. Lexer a -> Lexer [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Lexer Char -> Lexer MisoString) -> Lexer Char -> Lexer MisoString
forall a b. (a -> b) -> a -> b
$ do
  (Char -> Bool) -> Lexer Char
L.satisfy ((Char -> Bool) -> Lexer Char) -> (Char -> Bool) -> Lexer Char
forall a b. (a -> b) -> a -> b
$ \Char
x -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
    [ Char -> Bool
isAlphaNum Char
x
    , Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'
    , Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'
    , Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'~'
    , Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'%'
    , Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.'
    ]
-----------------------------------------------------------------------------
lexTokens :: MisoString -> Either L.LexerError [Token]
lexTokens :: MisoString -> Either LexerError [Token]
lexTokens MisoString
input =
  case Lexer [Token] -> Stream -> Either LexerError ([Token], Stream)
forall token.
Lexer token -> Stream -> Either LexerError (token, Stream)
L.runLexer Lexer [Token]
uriLexer (MisoString -> Stream
L.mkStream MisoString
input) of
    Right ([Token]
tokens, Stream
_) -> [Token] -> Either LexerError [Token]
forall a b. b -> Either a b
Right [Token]
tokens
    Left LexerError
x -> LexerError -> Either LexerError [Token]
forall a b. a -> Either a b
Left LexerError
x
-----------------------------------------------------------------------------
parseRoute :: MisoString -> RouteParser a -> Either RoutingError a
parseRoute :: forall a. MisoString -> RouteParser a -> Either RoutingError a
parseRoute MisoString
input RouteParser a
parser =
  case Lexer [Token] -> Stream -> Either LexerError ([Token], Stream)
forall token.
Lexer token -> Stream -> Either LexerError (token, Stream)
L.runLexer Lexer [Token]
uriLexer (MisoString -> Stream
L.mkStream MisoString
input) of
    Left (L.LexerError MisoString
lexErrorMessage Location
_) ->
      RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left (MisoString -> MisoString -> RoutingError
LexError MisoString
input MisoString
lexErrorMessage)
    Left (L.UnexpectedEOF Location
_) ->
      RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left (MisoString -> RoutingError
LexErrorEOF MisoString
input)
    Right ([Token]
tokens, Stream
_) -> do
      let
        uri :: URI
uri = [Token] -> URI
tokensToURI [Token]
tokens
        isCapturePathOrIndex :: Token -> Bool
isCapturePathOrIndex = \case
          CaptureOrPathToken{} -> Bool
True
          IndexToken{} -> Bool
True
          Token
_ -> Bool
False
      case RouteParser a -> URI -> [Token] -> [(a, [Token])]
forall r token (m :: * -> *) a.
ParserT r token m a -> r -> token -> m (a, token)
runParserT RouteParser a
parser URI
uri ((Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter Token -> Bool
isCapturePathOrIndex [Token]
tokens) of
        [(a
x, [])]  ->
          a -> Either RoutingError a
forall a b. b -> Either a b
Right a
x
        [(a
_, [Token]
leftovers)]  ->
          RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left (RoutingError -> Either RoutingError a)
-> RoutingError -> Either RoutingError a
forall a b. (a -> b) -> a -> b
$ MisoString -> [Token] -> RoutingError
ParseError MisoString
input [Token]
leftovers
        []  ->
          RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left (RoutingError -> Either RoutingError a)
-> RoutingError -> Either RoutingError a
forall a b. (a -> b) -> a -> b
$ MisoString -> RoutingError
NoParses MisoString
input
        (a
_, [Token]
leftovers) : [(a, [Token])]
_  ->
          RoutingError -> Either RoutingError a
forall a b. a -> Either a b
Left (RoutingError -> Either RoutingError a)
-> RoutingError -> Either RoutingError a
forall a b. (a -> b) -> a -> b
$ MisoString -> [Token] -> RoutingError
AmbiguousParse MisoString
input [Token]
leftovers
-----------------------------------------------------------------------------
lowercaseStrip :: String -> MisoString
lowercaseStrip :: [Char] -> MisoString
lowercaseStrip (Char
x:[Char]
xs) = [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms (Char -> Char
C.toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
C.isLower [Char]
xs)
lowercaseStrip [Char]
x = [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
ms [Char]
x
-----------------------------------------------------------------------------
-- | Type for dealing with @URI@
--
-- <<https://datatracker.ietf.org/doc/html/rfc3986>>
--
data URI
  = URI
  { URI -> MisoString
uriPath, URI -> MisoString
uriFragment :: MisoString
  , URI -> Map MisoString (Maybe MisoString)
uriQueryString :: M.Map MisoString (Maybe MisoString)
  } deriving (Int -> URI -> ShowS
[URI] -> ShowS
URI -> [Char]
(Int -> URI -> ShowS)
-> (URI -> [Char]) -> ([URI] -> ShowS) -> Show URI
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> URI -> ShowS
showsPrec :: Int -> URI -> ShowS
$cshow :: URI -> [Char]
show :: URI -> [Char]
$cshowList :: [URI] -> ShowS
showList :: [URI] -> ShowS
Show, URI -> URI -> Bool
(URI -> URI -> Bool) -> (URI -> URI -> Bool) -> Eq URI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: URI -> URI -> Bool
== :: URI -> URI -> Bool
$c/= :: URI -> URI -> Bool
/= :: URI -> URI -> Bool
Eq)
----------------------------------------------------------------------------
emptyURI :: URI
emptyURI :: URI
emptyURI = MisoString
-> MisoString -> Map MisoString (Maybe MisoString) -> URI
URI MisoString
forall a. Monoid a => a
mempty MisoString
forall a. Monoid a => a
mempty Map MisoString (Maybe MisoString)
forall a. Monoid a => a
mempty
----------------------------------------------------------------------------
instance ToMisoString URI where
  toMisoString :: URI -> MisoString
toMisoString = URI -> MisoString
prettyURI
----------------------------------------------------------------------------