happstack-static-routing 0.6.0.0 → 0.7.0.0

raw patch · 3 files changed

+56/−56 lines, 3 filesdep ~basedep ~containersdep ~happstack-servernew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, containers, happstack-server, list-tries, transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• happstack-static-routing.cabal +13/−15
• src/Happstack/StaticRouting/Internal.hs +38/−41

@@ -1,3 +1,8 @@+# happstack-static-routing-0.7.0.0  (2022-02-15)+* Improve functional dependencies of 'Path'.+* Generalize the type signature of 'compile'.+* Expose the internal module.+ # happstack-static-routing-0.6.0.0  (2017-06-20) * No longer uses OverlappingInstances. 

@@ -1,5 +1,5 @@ Name:                happstack-static-routing-Version:             0.6.0.0+Version:             0.7.0.0 Synopsis: Support for static URL routing with overlap detection for Happstack.  Description: If you have a large routing table in Happstack and want@@ -22,9 +22,8 @@ Stability:           Development Category:            Web, Distributed Computing Build-type:          Simple-Cabal-version:       >=1.6-Tested-with:         GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4,-                     GHC == 7.10.3, GHC == 8.0.1+Cabal-version:       >=1.10+Tested-with:         GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.1 Extra-source-files:  README.md, CHANGELOG.md  source-repository head@@ -32,16 +31,15 @@   location: git://github.com/scrive/happstack-static-routing.git  library-  exposed-modules:-     Happstack.StaticRouting--  other-modules:-     Happstack.StaticRouting.Internal+  default-language: Haskell2010+  hs-source-dirs:   src+  ghc-options:      -Wall -  hs-source-dirs: src+  build-depends: base             >= 4.12 && < 5+               , containers       >= 0.3  && < 0.7+               , happstack-server >= 6    && < 8+               , list-tries       >= 0.4  && < 0.7+               , transformers     >= 0.2  && < 0.6 -  build-depends: base >= 4 && <= 10-  build-depends: happstack-server >= 6-  build-depends: containers >= 0.3-  build-depends: list-tries >= 0.4-  build-depends: transformers >= 0.2+  exposed-modules: Happstack.StaticRouting+                   Happstack.StaticRouting.Internal

@@ -1,33 +1,34 @@-{-# LANGUAGE FunctionalDependencies, ScopedTypeVariables,-    MultiParamTypeClasses, FlexibleInstances, UndecidableInstances,-    FlexibleContexts, DeriveFunctor, PatternGuards, TupleSections #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_HADDOCK hide #-}- module Happstack.StaticRouting.Internal where -import Debug.Trace--import Happstack.Server(askRq, rqPaths, rqMethod, localRq, ServerMonad, Method,-  HasRqData, methodM, look, FromReqURI, fromReqURI, notFound, Response, toResponse, FilterMonad)-import Control.Monad(msum, MonadPlus, mzero, mplus, liftM)-import Control.Monad.IO.Class(MonadIO)-import Control.Arrow(first, second)+import Control.Arrow (first)+import Control.Monad (liftM, mplus)+import Data.Map (Map)+import Data.Maybe+import Happstack.Server+  ( FromReqURI, Method, ServerMonad, askRq, fromReqURI, localRq, rqMethod, rqPaths+  ) import qualified Data.ListTrie.Map as Trie-import Data.Map(Map) import qualified Data.Map as Map-import Data.List(intercalate,find)-import Data.Maybe  -- | Static routing tables consisting of handlers of type 'a'.-data Route a =-    Dir Segment (Route a)+data Route a+  = Dir Segment (Route a)   | Param (Route a)   | Handler EndSegment CheckApply a   | Choice [Route a]   deriving Functor -data Segment =-    StringS String | ParamS+data Segment = StringS String | ParamS   deriving (Show, Eq, Ord)  type EndSegment = (Maybe Int, Method)@@ -35,21 +36,21 @@ type CheckApply = [String] -> Bool  -- | Support for varying number of arguments to 'path' handlers.-class Path m hm h r | h r -> m where-  pathHandler :: forall r'. (m r -> hm r') -> h -> hm r'-  arity       :: hm r -> h -> Int-  canBeApplied :: hm r -> h -> [String] -> Bool+class Path m hm h r | h -> m r where+  pathHandler  :: forall r'. (m r -> hm r') -> h -> hm r'+  arity        :: h -> Int+  canBeApplied :: h -> [String] -> Bool -instance (-    FromReqURI v+instance+  ( FromReqURI v   , ServerMonad hm   , Path m hm h r   ) => Path m hm (v -> h) r where     pathHandler trans f = applyPath (pathHandler trans . f)-    arity m f = 1 + arity m (f undefined)-    canBeApplied m f [] = False-    canBeApplied m f (s:ss) = case (fromReqURI s) of-                                Just p -> canBeApplied m (f p) ss+    arity f = 1 + arity @m @hm (f undefined)+    canBeApplied _ [] = False+    canBeApplied f (s:ss) = case (fromReqURI s) of+                                Just p -> canBeApplied @m @hm (f p) ss                                 Nothing -> False  @@ -66,8 +67,8 @@  instance Path m hm (m r) r where   pathHandler trans mr = trans mr-  arity _ _ = 0-  canBeApplied _ _ _ = True+  arity _ = 0+  canBeApplied _ _ = True  -- | Pop a path element if it matches the given string. dir :: String -> Route a -> Route a@@ -84,7 +85,7 @@ -- | Expect the given method, and exactly 'n' more segments, where 'n' is the arity of the handler. path :: forall m hm h r r'. Path m hm h r      => Method -> (m r -> hm r') -> h -> Route (hm r')-path m trans h = Handler (Just (arity (undefined::hm r) h), m) (canBeApplied (undefined::hm r) h) (pathHandler trans h)+path m trans h = Handler (Just (arity @m @hm h), m) (canBeApplied @m @hm h) (pathHandler trans h)  -- | Expect zero or more segments. remainingPath :: Method -> h -> Route h@@ -93,7 +94,7 @@ newtype RouteTree a =   R { unR :: Trie.TrieMap Map Segment (Map EndSegment a) } deriving (Show, Functor) -type Segments = ([Segment],EndSegment)+type Segments = ([Segment], EndSegment)  -- | Compile a route into a 'RouteTree'.  Turn overlapping routes into 'Nothing' routeTreeWithOverlaps :: Route a -> RouteTree (Maybe (CheckApply,a))@@ -109,7 +110,7 @@  -- | Check for overlaps in a 'RouteTree', returning either an error -- message in case of an overlap, or a 'RouteTree' without overlaps.-routeTree :: RouteTree (Maybe (CheckApply,a)) -> Either String (RouteTree (CheckApply,a))+routeTree :: RouteTree (Maybe (CheckApply, a)) -> Either String (RouteTree (CheckApply, a)) routeTree t | not $ null os =                 Left $ unlines $                   "Happstack.StaticRouting: Overlapping handlers in" :@@ -151,16 +152,13 @@ -- describes the overlap.  Returns 'Right h', where h is a compiled -- handler that returns 'Nothing' in case no matching handler was -- found, otherwise 'Just response'.-compile :: (MonadIO m, HasRqData m, ServerMonad m, FilterMonad Response m) =>-           Route (m Response) -> Either String (m (Maybe Response))-compile r = case t of+compile :: ServerMonad m => Route (m r) -> Either String (m (Maybe r))+compile r = case routeTree $ routeTreeWithOverlaps r of               Left s -> Left s               Right t -> Right $ dispatch t-  where t = routeTree $ routeTreeWithOverlaps r  -- | Dispatch a request given a route.  Give priority to more specific paths.-dispatch :: forall m . (MonadIO m, HasRqData m, ServerMonad m, FilterMonad Response m) =>-            RouteTree (CheckApply,(m Response)) -> m (Maybe Response)+dispatch :: ServerMonad m => RouteTree (CheckApply, m r) -> m (Maybe r) dispatch t = do   rq  <- askRq   case dispatch' [] (rqMethod rq) (rqPaths rq) t of@@ -169,7 +167,7 @@  -- | Dispatch a request given a method and path.  Give priority to more specific paths. -- 'params' holds path segments that where matched 'ParamS' segment.-dispatch' :: forall a . [String] -> Method -> [String] -> RouteTree (CheckApply,a) -> Maybe ([String], a)+dispatch' :: forall a. [String] -> Method -> [String] -> RouteTree (CheckApply, a) -> Maybe ([String], a) dispatch' params m ps (R t) = dChildren ps `mplus` fmap (params ++ ps,) dNode   where   -- most specific: look up a segment in the children and recurse@@ -187,4 +185,3 @@     if (ac (params ++ ps))      then return h      else Nothing-