packages feed

miso 0.8.0.0 → 0.9.0.0

raw patch · 12 files changed

+257/−244 lines, 12 filesbinary-addedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

+ Miso.Router: Fail :: RoutingError
+ Miso.Router: FailFatal :: RoutingError
+ Miso.Router: class HasURI m
+ Miso.Router: data RoutingError
+ Miso.Router: getURI :: HasURI m => m -> URI
+ Miso.Router: instance (Miso.Router.HasRouter m x, Miso.Router.HasRouter m y) => Miso.Router.HasRouter m (x Servant.API.Alternative.:<|> y)
+ Miso.Router: instance GHC.Classes.Eq Miso.Router.Location
+ Miso.Router: instance GHC.Classes.Eq Miso.Router.RoutingError
+ Miso.Router: instance GHC.Classes.Ord Miso.Router.Location
+ Miso.Router: instance GHC.Classes.Ord Miso.Router.RoutingError
+ Miso.Router: instance GHC.Show.Show Miso.Router.Location
+ Miso.Router: instance GHC.Show.Show Miso.Router.RoutingError
+ Miso.Router: instance Miso.Router.HasRouter m (Miso.Html.Internal.View a)
+ Miso.Router: instance forall k m (sublayout :: k) (path :: GHC.Types.Symbol). (Miso.Router.HasRouter m sublayout, GHC.TypeLits.KnownSymbol path) => Miso.Router.HasRouter m (path Servant.API.Sub.:> sublayout)
+ Miso.Router: instance forall k m (sublayout :: k) (sym :: GHC.Types.Symbol). (Miso.Router.HasRouter m sublayout, GHC.TypeLits.KnownSymbol sym) => Miso.Router.HasRouter m (Servant.API.QueryParam.QueryFlag sym Servant.API.Sub.:> sublayout)
+ Miso.Router: instance forall k m (sublayout :: k) x (sym :: GHC.Types.Symbol). (Miso.Router.HasRouter m sublayout, Web.Internal.HttpApiData.FromHttpApiData x) => Miso.Router.HasRouter m (Servant.API.Capture.Capture sym x Servant.API.Sub.:> sublayout)
+ Miso.Router: instance forall k m (sublayout :: k) x (sym :: GHC.Types.Symbol). (Miso.Router.HasRouter m sublayout, Web.Internal.HttpApiData.FromHttpApiData x, GHC.TypeLits.KnownSymbol sym) => Miso.Router.HasRouter m (Servant.API.QueryParam.QueryParam sym x Servant.API.Sub.:> sublayout)
+ Miso.Router: instance forall k m (sublayout :: k) x (sym :: GHC.Types.Symbol). (Miso.Router.HasRouter m sublayout, Web.Internal.HttpApiData.FromHttpApiData x, GHC.TypeLits.KnownSymbol sym) => Miso.Router.HasRouter m (Servant.API.QueryParam.QueryParams sym x Servant.API.Sub.:> sublayout)
+ Miso.Router: lensURI :: HasURI m => Lens' m URI
+ Miso.Router: makeLens :: (s -> a) -> (s -> b -> t) -> Lens s t a b
+ Miso.Router: runRoute :: (HasURI m, HasRouter m layout) => Proxy layout -> RouteT m layout a -> m -> Either RoutingError a
+ Miso.Router: setURI :: HasURI m => URI -> m -> m

Files

examples/mario/Main.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE BangPatterns      #-} module Main where +import           Data.Bool import           Data.Function import qualified Data.Map      as M import           Data.Monoid@@ -20,6 +21,9 @@ foreign import javascript unsafe "$r = performance.now();"   now :: IO Double +spriteFrames :: [MisoString]+spriteFrames = ["0 0", "-74px 0","-111px 0","-148px 0","-185px 0","-222px 0","-259px 0","-296px 0"]+ main :: IO () main = do     time <- now@@ -113,32 +117,33 @@ display m@Model{..} = marioImage   where     (h,w) = window-    verb = if | y > 0 -> "jump"-              | vx /= 0 -> "walk"-              | otherwise -> "stand"-    d = case dir of-            L -> "left"-            R -> "right"-    src  = "imgs/"<> verb <> "/" <> d <> ".gif"     groundY = 62 - (fromIntegral (fst window) / 2)     marioImage =       div_ [ height_ $ pack (show h)-           , height_ $ pack (show w)-           ] [ img_ [ height_ "37"-                    , width_ "37"-                    , src_ src-                    , style_ (marioStyle m groundY)-                    ] [] ]+           , width_ $ pack (show w)+           ] [ div_ [ style_ (marioStyle m groundY) ] [] ]  marioStyle :: Model -> Double -> M.Map MisoString MisoString marioStyle Model {..} gy =-  M.fromList [ ("transform", matrix x $ abs (y + gy) )+  M.fromList [ ("transform", matrix dir x $ abs (y + gy) )              , ("display", "block")+             , ("width", "37px")+             , ("height", "37px")+             , ("background-color", "transparent")+             , ("background-image", "url(imgs/mario.png)")+             , ("background-repeat", "no-repeat")+             , ("background-position", spriteFrames !! frame)+             , bool mempty ("animation", "play 0.8s steps(8) infinite") (y == 0 && vx /= 0)              ]+  where+    frame | y > 0 = 1+          | otherwise = 0 -matrix :: Double -> Double -> MisoString-matrix x y =-  "matrix(1,0,0,1,"+matrix :: Direction -> Double -> Double -> MisoString+matrix dir x y =+  "matrix("+     <> (if dir == L then "-1" else "1")+     <> ",0,0,1,"      <> pack (show x)      <> ","      <> pack (show y)
− examples/mario/imgs/jump/left.gif

binary file changed (287 → absent bytes)

− examples/mario/imgs/jump/right.gif

binary file changed (283 → absent bytes)

+ examples/mario/imgs/mario.png view

binary file changed (absent → 4869 bytes)

− examples/mario/imgs/stand/left.gif

binary file changed (357 → absent bytes)

− examples/mario/imgs/stand/right.gif

binary file changed (364 → absent bytes)

− examples/mario/imgs/walk/left.gif

binary file changed (1732 → absent bytes)

− examples/mario/imgs/walk/right.gif

binary file changed (1763 → absent bytes)

+ examples/mario/index.html view
@@ -0,0 +1,12 @@+<!DOCTYPE html>+<html>+  <head>+    <meta charset="utf-8">+    <style>+      @keyframes play { 100% { background-position: -296px; } }+    </style>+  </head>+  <body>+    <script src='all.js'></script>+  </body>+</html>
− ghcjs-src/Miso/Router.hs 
@@ -1,216 +0,0 @@-{-# 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-2017 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-  , RoutingError (..)-  , HasURI (..)-  , getURI-  , setURI-  , makeLens-  ) 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-import           Network.URI-import           Servant.API-import           Web.HttpApiData--import           Miso.Html             hiding (text)-import           Miso.Lens---- | 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-  { locPath  :: [Text]-  , locQuery :: Query-  } deriving (Show, Eq, Ord)---- | When routing, the router may fail to match a location.--- Either this is an unrecoverable failure,--- such as failing to parse a query parameter,--- or it is recoverable by trying another path.-data RoutingError-  = Fail-  | FailFatal-  deriving (Show, Eq, 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 model layout where-  -- | A route handler.-  type RouteT model layout a :: *-  -- | Transform a route handler into a 'Router'.-  route :: Proxy layout -> Proxy a -> RouteT model layout a -> model -> Router a---- | Alternative-instance (HasRouter m x, HasRouter m y) => HasRouter m (x :<|> y) where-  type RouteT m (x :<|> y) a = RouteT m x a :<|> RouteT m y a-  route _ (a :: Proxy a) ((x :: RouteT m x a) :<|> (y :: RouteT m y a)) m-    = RChoice (route (Proxy :: Proxy x) a x m) (route (Proxy :: Proxy y) a y m)---- | Capture-instance (HasRouter m sublayout, FromHttpApiData x) =>-  HasRouter m (Capture sym x :> sublayout) where-  type RouteT m (Capture sym x :> sublayout) a = x -> RouteT m sublayout a-  route _ a f m = RCapture (\x -> route (Proxy :: Proxy sublayout) a (f x) m)---- | QueryParam-instance (HasRouter m sublayout, FromHttpApiData x, KnownSymbol sym)-         => HasRouter m (QueryParam sym x :> sublayout) where-  type RouteT m (QueryParam sym x :> sublayout) a = Maybe x -> RouteT m sublayout a-  route _ a f m = RQueryParam (Proxy :: Proxy sym)-    (\x -> route (Proxy :: Proxy sublayout) a (f x) m)---- | QueryParams-instance (HasRouter m sublayout, FromHttpApiData x, KnownSymbol sym)-         => HasRouter m (QueryParams sym x :> sublayout) where-  type RouteT m (QueryParams sym x :> sublayout) a = [x] -> RouteT m sublayout a-  route _ a f m = RQueryParams-    (Proxy :: Proxy sym)-    (\x -> route (Proxy :: Proxy sublayout) a (f x) m)---- | QueryFlag-instance (HasRouter m sublayout, KnownSymbol sym)-         => HasRouter m (QueryFlag sym :> sublayout) where-  type RouteT m (QueryFlag sym :> sublayout) a = Bool -> RouteT m sublayout a-  route _ a f m = RQueryFlag-    (Proxy :: Proxy sym)-    (\x -> route (Proxy :: Proxy sublayout) a (f x) m)---- | Path-instance (HasRouter m sublayout, KnownSymbol path)-         => HasRouter m (path :> sublayout) where-  type RouteT m (path :> sublayout) a = RouteT m sublayout a-  route _ a page m = RPath-    (Proxy :: Proxy path)-    (route (Proxy :: Proxy sublayout) a page m)---- | View-instance HasRouter m (View a) where-  type RouteT m (View a) x = m -> x-  route _ _ a m = RPage (a m)---- | Use a handler to route a 'Location'.--- Normally 'runRoute' should be used instead, unless you want custom--- handling of string failing to parse as 'URI'.-runRouteLoc :: forall m layout a. HasRouter m layout-            => Location -> Proxy layout -> RouteT m layout a -> m -> Either RoutingError a-runRouteLoc loc layout page m =-  let routing = route layout (Proxy :: Proxy a) page m-  in routeLoc loc routing m---- | Use a handler to route a location, represented as a 'String'.--- All handlers must, in the end, return @m a@.--- 'routeLoc' will choose a route and return its result.-runRoute-  :: (HasURI m, HasRouter m layout)-  => Proxy layout-  -> RouteT m layout a-  -> m-  -> Either RoutingError a-runRoute layout page m = runRouteLoc (uriToLocation (getURI m)) layout page m---- | Use a computed 'Router' to route a 'Location'.-routeLoc :: Location -> Router a -> m -> Either RoutingError a-routeLoc loc r m = case r of-  RChoice a b -> do-    case routeLoc loc a m of-      Left Fail -> routeLoc loc b m-      Left FailFatal -> Left FailFatal-      Right x -> Right x-  RCapture f -> case locPath loc of-    [] -> Left Fail-    capture:paths ->-      case parseUrlPieceMaybe capture of-        Nothing -> Left FailFatal-        Just x -> routeLoc loc { locPath = paths } (f x) m-  RQueryParam sym f -> case lookup (BS.pack $ symbolVal sym) (locQuery loc) of-    Nothing -> routeLoc loc (f Nothing) m-    Just Nothing -> Left FailFatal-    Just (Just text) -> case parseQueryParamMaybe (decodeUtf8 text) of-      Nothing -> Left FailFatal-      Just x -> routeLoc loc (f (Just x)) m-  RQueryParams sym f -> maybe (Left FailFatal) (\x -> routeLoc loc (f x) m) $ do-    ps <- sequence $ snd <$> Prelude.filter-      (\(k, _) -> k == BS.pack (symbolVal sym)) (locQuery loc)-    sequence $ (parseQueryParamMaybe . decodeUtf8) <$> ps-  RQueryFlag sym f -> case lookup (BS.pack $ symbolVal sym) (locQuery loc) of-    Nothing -> routeLoc loc (f False) m-    Just Nothing -> routeLoc loc (f True) m-    Just (Just _) -> Left FailFatal-  RPath sym a -> case locPath loc of-    [] -> Left Fail-    p:paths -> if p == T.pack (symbolVal sym)-      then routeLoc (loc { locPath = paths }) a m-      else Left Fail-  RPage a ->-    case locPath loc of-      [] -> Right a-      _ -> Left Fail---- | Convert a 'URI' to a 'Location'.-uriToLocation :: URI -> Location-uriToLocation uri = Location-  { locPath = decodePathSegments $ BS.pack (uriPath uri)-  , locQuery = parseQuery $ BS.pack (uriQuery uri)-  }--class HasURI m where lensURI :: Lens' m URI--getURI :: HasURI m => m -> URI-getURI = get lensURI--setURI :: HasURI m => URI -> m -> m-setURI m u = set lensURI m u-----
miso.cabal view
@@ -1,5 +1,5 @@ name:                miso-version:             0.8.0.0+version:             0.9.0.0 category:            Web, Miso, Data Structures license:             BSD3 license-file:        LICENSE@@ -18,12 +18,8 @@   README.md   examples/todo-mvc/index.html   examples/websocket/index.html-  examples/mario/imgs/jump/right.gif-  examples/mario/imgs/jump/left.gif-  examples/mario/imgs/stand/right.gif-  examples/mario/imgs/stand/left.gif-  examples/mario/imgs/walk/right.gif-  examples/mario/imgs/walk/left.gif+  examples/mario/index.html+  examples/mario/imgs/mario.png  flag examples   default:@@ -259,6 +255,7 @@     Miso.Event     Miso.Event.Decoder     Miso.Event.Types+    Miso.Router     Miso.Svg     Miso.Svg.Attribute     Miso.Svg.Element@@ -276,6 +273,9 @@     base < 5,     bytestring,     containers,+    http-api-data,+    http-types,+    network-uri,     servant,     text,     transformers@@ -284,9 +284,6 @@       ghcjs-src     build-depends:       ghcjs-base,-      http-types,-      network-uri,-      http-api-data,       containers,       scientific,       unordered-containers,@@ -303,7 +300,6 @@       Miso.Effect.Storage       Miso.Effect.XHR       Miso.Effect.DOM-      Miso.Router       Miso.Subscription       Miso.Subscription.History       Miso.Subscription.Keyboard
+ src/Miso/Router.hs view
@@ -0,0 +1,216 @@+{-# 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-2017 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+  , RoutingError (..)+  , HasURI (..)+  , getURI+  , setURI+  , makeLens+  ) 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+import           Network.URI+import           Servant.API+import           Web.HttpApiData++import           Miso.Html             hiding (text)+import           Miso.Lens++-- | 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+  { locPath  :: [Text]+  , locQuery :: Query+  } deriving (Show, Eq, Ord)++-- | When routing, the router may fail to match a location.+-- Either this is an unrecoverable failure,+-- such as failing to parse a query parameter,+-- or it is recoverable by trying another path.+data RoutingError+  = Fail+  | FailFatal+  deriving (Show, Eq, 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 model layout where+  -- | A route handler.+  type RouteT model layout a :: *+  -- | Transform a route handler into a 'Router'.+  route :: Proxy layout -> Proxy a -> RouteT model layout a -> model -> Router a++-- | Alternative+instance (HasRouter m x, HasRouter m y) => HasRouter m (x :<|> y) where+  type RouteT m (x :<|> y) a = RouteT m x a :<|> RouteT m y a+  route _ (a :: Proxy a) ((x :: RouteT m x a) :<|> (y :: RouteT m y a)) m+    = RChoice (route (Proxy :: Proxy x) a x m) (route (Proxy :: Proxy y) a y m)++-- | Capture+instance (HasRouter m sublayout, FromHttpApiData x) =>+  HasRouter m (Capture sym x :> sublayout) where+  type RouteT m (Capture sym x :> sublayout) a = x -> RouteT m sublayout a+  route _ a f m = RCapture (\x -> route (Proxy :: Proxy sublayout) a (f x) m)++-- | QueryParam+instance (HasRouter m sublayout, FromHttpApiData x, KnownSymbol sym)+         => HasRouter m (QueryParam sym x :> sublayout) where+  type RouteT m (QueryParam sym x :> sublayout) a = Maybe x -> RouteT m sublayout a+  route _ a f m = RQueryParam (Proxy :: Proxy sym)+    (\x -> route (Proxy :: Proxy sublayout) a (f x) m)++-- | QueryParams+instance (HasRouter m sublayout, FromHttpApiData x, KnownSymbol sym)+         => HasRouter m (QueryParams sym x :> sublayout) where+  type RouteT m (QueryParams sym x :> sublayout) a = [x] -> RouteT m sublayout a+  route _ a f m = RQueryParams+    (Proxy :: Proxy sym)+    (\x -> route (Proxy :: Proxy sublayout) a (f x) m)++-- | QueryFlag+instance (HasRouter m sublayout, KnownSymbol sym)+         => HasRouter m (QueryFlag sym :> sublayout) where+  type RouteT m (QueryFlag sym :> sublayout) a = Bool -> RouteT m sublayout a+  route _ a f m = RQueryFlag+    (Proxy :: Proxy sym)+    (\x -> route (Proxy :: Proxy sublayout) a (f x) m)++-- | Path+instance (HasRouter m sublayout, KnownSymbol path)+         => HasRouter m (path :> sublayout) where+  type RouteT m (path :> sublayout) a = RouteT m sublayout a+  route _ a page m = RPath+    (Proxy :: Proxy path)+    (route (Proxy :: Proxy sublayout) a page m)++-- | View+instance HasRouter m (View a) where+  type RouteT m (View a) x = m -> x+  route _ _ a m = RPage (a m)++-- | Use a handler to route a 'Location'.+-- Normally 'runRoute' should be used instead, unless you want custom+-- handling of string failing to parse as 'URI'.+runRouteLoc :: forall m layout a. HasRouter m layout+            => Location -> Proxy layout -> RouteT m layout a -> m -> Either RoutingError a+runRouteLoc loc layout page m =+  let routing = route layout (Proxy :: Proxy a) page m+  in routeLoc loc routing m++-- | Use a handler to route a location, represented as a 'String'.+-- All handlers must, in the end, return @m a@.+-- 'routeLoc' will choose a route and return its result.+runRoute+  :: (HasURI m, HasRouter m layout)+  => Proxy layout+  -> RouteT m layout a+  -> m+  -> Either RoutingError a+runRoute layout page m = runRouteLoc (uriToLocation (getURI m)) layout page m++-- | Use a computed 'Router' to route a 'Location'.+routeLoc :: Location -> Router a -> m -> Either RoutingError a+routeLoc loc r m = case r of+  RChoice a b -> do+    case routeLoc loc a m of+      Left Fail -> routeLoc loc b m+      Left FailFatal -> Left FailFatal+      Right x -> Right x+  RCapture f -> case locPath loc of+    [] -> Left Fail+    capture:paths ->+      case parseUrlPieceMaybe capture of+        Nothing -> Left FailFatal+        Just x -> routeLoc loc { locPath = paths } (f x) m+  RQueryParam sym f -> case lookup (BS.pack $ symbolVal sym) (locQuery loc) of+    Nothing -> routeLoc loc (f Nothing) m+    Just Nothing -> Left FailFatal+    Just (Just text) -> case parseQueryParamMaybe (decodeUtf8 text) of+      Nothing -> Left FailFatal+      Just x -> routeLoc loc (f (Just x)) m+  RQueryParams sym f -> maybe (Left FailFatal) (\x -> routeLoc loc (f x) m) $ do+    ps <- sequence $ snd <$> Prelude.filter+      (\(k, _) -> k == BS.pack (symbolVal sym)) (locQuery loc)+    sequence $ (parseQueryParamMaybe . decodeUtf8) <$> ps+  RQueryFlag sym f -> case lookup (BS.pack $ symbolVal sym) (locQuery loc) of+    Nothing -> routeLoc loc (f False) m+    Just Nothing -> routeLoc loc (f True) m+    Just (Just _) -> Left FailFatal+  RPath sym a -> case locPath loc of+    [] -> Left Fail+    p:paths -> if p == T.pack (symbolVal sym)+      then routeLoc (loc { locPath = paths }) a m+      else Left Fail+  RPage a ->+    case locPath loc of+      [] -> Right a+      _ -> Left Fail++-- | Convert a 'URI' to a 'Location'.+uriToLocation :: URI -> Location+uriToLocation uri = Location+  { locPath = decodePathSegments $ BS.pack (uriPath uri)+  , locQuery = parseQuery $ BS.pack (uriQuery uri)+  }++class HasURI m where lensURI :: Lens' m URI++getURI :: HasURI m => m -> URI+getURI = get lensURI++setURI :: HasURI m => URI -> m -> m+setURI m u = set lensURI m u+++++