Shpadoinkle-router 0.2.0.1 → 0.3.0.0

raw patch · 3 files changed

+60/−37 lines, 3 filesdep +http-typesdep +servant-rawmdep +servant-rawm-serverdep ~servant-clientPVP ok

version bump matches the API change (PVP)

Dependencies added: http-types, servant-rawm, servant-rawm-server

Dependency ranges changed: servant-client

API changes (from Hackage documentation)

Files

• Shpadoinkle-router.cabal +6/−3
• Shpadoinkle/Router.hs +42/−29
• Shpadoinkle/Router/Server.hs +12/−5

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 287b71ef93760ce3e427d0d14f772ed6bee4c147edd12b6879f767ff727d2f7b+-- hash: 3c7184e4c455d500951338935b68b93a593204314315d262e725f0540ee0bbd9  name:           Shpadoinkle-router-version:        0.2.0.1+version:        0.3.0.0 synopsis:       A single page application rounter for Shpadoinkle based on Servant. description:    Surjective single page application routing with Servant. Surjectivity in this context means routes can be backward compatible, allowing URLs to evolve. Since routes are specified as Servant combinators, serving these routes from the backend is trivial. For an example of leveraging the client-server isomorphism via Servant specification, check the servant-crud example. category:       Web@@ -48,6 +48,7 @@     , lens >=4.17.1 && <5.0     , network-uri >=2.6.1 && <2.8     , servant >=0.16 && <0.19+    , servant-rawm     , text >=1.2.3 && <1.3     , unliftio >=0.2.12 && <0.3   if impl(ghcjs)@@ -56,9 +57,11 @@   else     build-depends:         Shpadoinkle-backend-static+      , http-types       , jsaddle-warp-      , servant-client >=0.16.0 && <0.18+      , servant-client >=0.15.0 && <0.19       , servant-client-js >=0.1 && <0.2+      , servant-rawm-server       , servant-server >=0.16 && <0.18       , wai >=3.2.2 && <3.3       , wai-app-static >=3.1.6 && <3.2

@@ -40,7 +40,7 @@     -- * Rehydration     , withHydration, toHydration     -- * Re-Exports-    , Raw, MonadJSM, HasLink(..)+    , Raw, S.RawM', S.RawM, MonadJSM, HasLink(..)     ) where  @@ -74,24 +74,25 @@                                                 IsElem, MimeRender (..),                                                 QueryFlag, QueryParam,                                                 QueryParam', QueryParams, Raw,-                                                Required, type (:<|>) (..),-                                                type (:>))+                                                Required, parseQueryParam,+                                                type (:<|>) (..), type (:>)) #else import           Servant.API                   (Capture, FromHttpApiData,                                                 HasLink (..), IsElem, QueryFlag,                                                 QueryParam, QueryParam',                                                 QueryParams, Raw, Required,+                                                parseQueryParam,                                                 type (:<|>) (..), type (:>)) #endif import           Servant.Links                 (Link, URI (..), linkURI,                                                 safeLink)+import qualified Servant.RawM                  as S import           System.IO.Unsafe              (unsafePerformIO) import           UnliftIO.Concurrent           (MVar, forkIO, newEmptyMVar,                                                 putMVar, takeMVar) import           UnliftIO.STM                  (TVar, atomically, newTVarIO,                                                 writeTVar)-import           Web.HttpApiData               (parseQueryParamMaybe,-                                                parseUrlPieceMaybe)+import           Web.HttpApiData               (parseUrlPiece)  import           Shpadoinkle                   (Backend, Continuation, Html,                                                 RawNode, h, hoist, kleisli, pur,@@ -104,8 +105,8 @@ import qualified Data.ByteString.Lazy          as BSL import qualified Data.List.NonEmpty            as NE import qualified Network.HTTP.Media            as M-import           Servant                       (Application, HasServer, Tagged) import qualified Servant                       as S+import           Servant.RawM.Server           ()  import           Shpadoinkle.Backend.Static    (renderStatic) @@ -119,10 +120,10 @@ -- | Term level API representation 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-  RQueryParamR :: (FromHttpApiData x, KnownSymbol sym) => Proxy sym -> (x -> Router a) -> Router a-  RQueryParams :: (FromHttpApiData x, KnownSymbol sym) => Proxy sym -> ([x] -> Router a) -> Router a+  RCapture     :: (Text -> Either Text x) -> (x -> Router a) -> Router a+  RQueryParam  :: KnownSymbol sym => (Text -> Either Text x) -> Proxy sym -> (Maybe x -> Router a) -> Router a+  RQueryParamR :: KnownSymbol sym => (Text -> Either Text x) -> Proxy sym -> (x -> Router a) -> Router a+  RQueryParams :: KnownSymbol sym => (Text -> Either Text x) -> 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   RView        :: a -> Router a@@ -330,23 +331,23 @@   return ()  --- | Get an @r@ from a route and URL context+-- | Get an @r@ from a route and url context fromRouter :: [(Text,Text)] -> [Text] -> Router r -> Maybe r fromRouter queries segs = \case-    RChoice x y        -> fromRouter queries segs x <|> fromRouter queries segs y-    RCapture f         -> case segs of-        []                 -> Nothing-        capture:paths      -> fromRouter queries paths . f =<< parseUrlPieceMaybe capture-    RQueryParam sym f  ->+    RChoice x y                -> fromRouter queries segs x <|> fromRouter queries segs y+    RCapture decoder f         -> case segs of+        []            -> Nothing+        capture:paths -> fromRouter queries paths . f =<< mabify decoder capture+    RQueryParam decoder sym f  ->         case lookup (T.pack $ symbolVal sym) queries of             Nothing -> fromRouter queries segs $ f Nothing-            Just t  -> fromRouter queries segs $ f (parseQueryParamMaybe t)-    RQueryParamR sym f ->+            Just t  -> fromRouter queries segs $ f (mabify decoder t)+    RQueryParamR decoder sym f ->        case lookup (T.pack $ symbolVal sym) queries of             Nothing -> Nothing-            Just t  -> fromRouter queries segs . f =<< parseQueryParamMaybe t-    RQueryParams sym f ->-        fromRouter queries segs . f . compact $ parseQueryParamMaybe . snd <$> C.filter+            Just t  -> fromRouter queries segs . f =<< mabify decoder t+    RQueryParams decoder sym f ->+        fromRouter queries segs . f . compact $ mabify decoder . snd <$> C.filter             (\(k, _) -> k == T.pack (symbolVal sym))             queries     RQueryFlag sym f ->@@ -356,6 +357,11 @@         p:paths            -> if p == T.pack (symbolVal sym) then             fromRouter queries paths a else Nothing     RView a            -> if null segs then Just a else Nothing+  where+    mabify :: (x -> Either e a) -> (x -> Maybe a)+    mabify f input = case f input of+                      (Left _)  -> Nothing+                      (Right x) -> Just x   -- | This type class traverses the Servant API and sets up a function to@@ -384,7 +390,7 @@     type (Capture sym x :> sub) :>> a = x -> sub :>> a      route :: (x -> sub :>> r) -> Router r-    route = RCapture . (route @sub .)+    route = RCapture parseUrlPiece . (route @sub .)     {-# INLINABLE route #-}  instance (HasRouter sub, FromHttpApiData x, KnownSymbol sym)@@ -393,7 +399,7 @@     type (QueryParam sym x :> sub) :>> a = Maybe x -> sub :>> a      route :: (Maybe x -> sub :>> r) -> Router r-    route = RQueryParam (Proxy @sym) . (route @sub .)+    route = RQueryParam parseQueryParam (Proxy @sym) . (route @sub .)     {-# INLINABLE route #-}  instance (HasRouter sub, FromHttpApiData x, KnownSymbol sym)@@ -402,7 +408,7 @@   type (QueryParam' '[Required] sym x :> sub) :>> a = x -> sub :>> a    route :: (x -> sub :>> r) -> Router r-  route = RQueryParamR (Proxy @sym) . (route @sub .)+  route = RQueryParamR parseQueryParam (Proxy @sym) . (route @sub .)  instance (HasRouter sub, FromHttpApiData x, KnownSymbol sym)     => HasRouter (QueryParams sym x :> sub) where@@ -410,7 +416,7 @@     type (QueryParams sym x :> sub) :>> a = [x] -> sub :>> a      route :: ([x] -> sub :>> r) -> Router r-    route = RQueryParams (Proxy @sym) . (route @sub .)+    route = RQueryParams parseQueryParam (Proxy @sym) . (route @sub .)     {-# INLINABLE route #-}  instance (HasRouter sub, KnownSymbol sym)@@ -438,6 +444,13 @@     route = RView     {-# INLINABLE route #-} +instance HasRouter (S.RawM' serverType) where+    type S.RawM' serverType :>> a = a++    route :: r -> Router r+    route = RView+    {-# INLINABLE route #-}+ instance HasRouter (f '[HTML] (Html m b)) where     type f '[HTML] (Html m b) :>> a = a @@ -466,10 +479,10 @@   mimeRender _ =  BSL.fromStrict . encodeUtf8 . renderStatic  -instance HasServer (View m a) context where-  type ServerT (View m a) m' = Tagged m' Application-  route _                   = S.route          (Proxy @Raw)-  hoistServerWithContext _  = S.hoistServerWithContext (Proxy @Raw)+instance S.HasServer (View m a) context where+  type ServerT (View m a) n = S.ServerT S.RawM n+  route _                    = S.route                  (Proxy @S.RawM)+  hoistServerWithContext _   = S.hoistServerWithContext (Proxy @S.RawM)   #endif

@@ -27,15 +27,16 @@  import           Data.ByteString.Lazy           as BS (ByteString, fromStrict,                                                        length)+import qualified Data.ByteString.Lazy           as BSL import           Data.Text.Encoding             (encodeUtf8) import           GHC.TypeLits                   (Symbol)-import           Network.Wai                    (responseLBS)+import           Network.HTTP.Types+import           Network.Wai                    (Application, responseLBS) import           Network.Wai.Application.Static (StaticSettings (ssLookupFile, ssMaxAge),                                                  defaultWebAppSettings,                                                  staticApp) import           Servant.API-import           Servant.Server                 (HasServer (ServerT), Server,-                                                 Tagged (Tagged))+import           Servant.Server                 (HasServer (ServerT), Server) import           Servant.Server.StaticFiles     (serveDirectoryWith) import           WaiAppStatic.Types             (File (..),                                                  LookupResult (LRFile, LRNotFound),@@ -145,6 +146,12 @@   {-# INLINABLE serveUI #-}  -serveDirectoryWithSpa :: StaticSettings -> ServerT (View m a) n-serveDirectoryWithSpa = Tagged . staticApp+serveDirectoryWithSpa :: Applicative n => StaticSettings -> ServerT (View m a) n+serveDirectoryWithSpa = pure . staticApp+++serveHtml :: Html m a -> Application+serveHtml html _ respond+  = respond . responseLBS status200 [(hContentType, "text/html")]+  . BSL.fromStrict . encodeUtf8 $ renderStatic html #endif