reroute 0.4.0.1 → 0.4.1.0
raw patch · 4 files changed
+32/−24 lines, 4 filesdep +http-api-datadep −path-piecesdep ~basedep ~hvect
Dependencies added: http-api-data
Dependencies removed: path-pieces
Dependency ranges changed: base, hvect
Files
- reroute.cabal +6/−6
- src/Web/Routing/Combinators.hs +6/−6
- src/Web/Routing/SafeRouting.hs +11/−11
- test/Spec.hs +9/−1
reroute.cabal view
@@ -1,5 +1,5 @@ name: reroute-version: 0.4.0.1+version: 0.4.1.0 synopsis: abstract implementation of typed and untyped web routing description: abstraction over how urls with/without parameters are mapped to their corresponding handlers homepage: http://github.com/agrafix/Spock@@ -7,7 +7,7 @@ license-file: LICENSE author: Alexander Thiemann <mail@athiemann.net>, Tim Baumann <tim@timbaumann.info> maintainer: Alexander Thiemann <mail@athiemann.net>-copyright: (c) 2014 - 2016 Alexander Thiemann <mail@athiemann.net>, Tim Baumann <tim@timbaumann.info>+copyright: (c) 2014 - 2017 Alexander Thiemann <mail@athiemann.net>, Tim Baumann <tim@timbaumann.info> category: Web build-type: Simple cabal-version: >=1.10@@ -22,14 +22,14 @@ Web.Routing.SafeRouting, Web.Routing.Combinators build-depends:- base >=4.6 && <5,+ base >=4.7 && <5, deepseq >= 1.1.0.2, hashable >=1.2, mtl >=2.1,- path-pieces >=0.1,+ http-api-data >=0.2, text >= 0.11.3.1, unordered-containers >=0.2,- hvect >=0.2+ hvect >=0.4 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall -fno-warn-orphans@@ -70,7 +70,7 @@ regex-compat, random, deepseq,- path-pieces,+ http-api-data, graph-core, hvect, reroute
src/Web/Routing/Combinators.hs view
@@ -10,7 +10,7 @@ import Data.HVect import Data.String import Data.Typeable (Typeable)-import Web.PathPieces+import Web.HttpApiData import qualified Data.Text as T import Web.Routing.SafeRouting@@ -20,7 +20,7 @@ data Path (as :: [*]) (pathState :: PathState) where Empty :: Path '[] 'Open StaticCons :: T.Text -> Path as ps -> Path as ps- VarCons :: (PathPiece a, Typeable a) => Path as ps -> Path (a ': as) ps+ VarCons :: (FromHttpApiData a, Typeable a) => Path as ps -> Path (a ': as) ps Wildcard :: Path as 'Open -> Path (T.Text ': as) 'Closed toInternalPath :: Path as pathState -> PathInternal as@@ -32,7 +32,7 @@ type Var a = Path (a ': '[]) 'Open -- | A route parameter-var :: (Typeable a, PathPiece a) => Path (a ': '[]) 'Open+var :: (Typeable a, FromHttpApiData a) => Path (a ': '[]) 'Open var = VarCons Empty -- | A static route piece@@ -63,15 +63,15 @@ pathToRep (VarCons p) = RCons (pathToRep p) pathToRep (Wildcard p) = RCons (pathToRep p) -renderRoute :: Path as 'Open -> HVect as -> T.Text+renderRoute :: AllHave ToHttpApiData as => Path as 'Open -> HVect as -> T.Text renderRoute p = combineRoutePieces . renderRoute' p -renderRoute' :: Path as 'Open -> HVect as -> [T.Text]+renderRoute' :: AllHave ToHttpApiData as => Path as 'Open -> HVect as -> [T.Text] renderRoute' Empty _ = [] renderRoute' (StaticCons pathPiece pathXs) paramXs = ( pathPiece : renderRoute' pathXs paramXs ) renderRoute' (VarCons pathXs) (val :&: paramXs) =- ( toPathPiece val : renderRoute' pathXs paramXs)+ ( toUrlPiece val : renderRoute' pathXs paramXs) #if __GLASGOW_HASKELL__ < 800 renderRoute' _ _ = error "This will never happen."
src/Web/Routing/SafeRouting.hs view
@@ -9,20 +9,20 @@ module Web.Routing.SafeRouting where -import qualified Data.PolyMap as PM import Data.HVect hiding (null, length) import qualified Data.HVect as HV+import qualified Data.PolyMap as PM import Data.Maybe #if MIN_VERSION_base(4,8,0) import Data.Monoid ((<>)) #else-import Data.Monoid (Monoid (..), (<>)) import Control.Applicative ((<$>))+import Data.Monoid (Monoid (..), (<>)) #endif-import Data.Typeable (Typeable) import Control.DeepSeq (NFData (..))-import Web.PathPieces+import Data.Typeable (Typeable)+import Web.HttpApiData import qualified Data.HashMap.Strict as HM import qualified Data.Text as T @@ -57,7 +57,7 @@ data PathInternal (as :: [*]) where PI_Empty :: PathInternal '[] -- the empty path PI_StaticCons :: T.Text -> PathInternal as -> PathInternal as -- append a static path piece to path- PI_VarCons :: (PathPiece a, Typeable a) => PathInternal as -> PathInternal (a ': as) -- append a param to path+ PI_VarCons :: (FromHttpApiData a, Typeable a) => PathInternal as -> PathInternal (a ': as) -- append a param to path PI_Wildcard :: PathInternal as -> PathInternal (T.Text ': as) -- append the rest of the route data PathMap x =@@ -65,7 +65,7 @@ { pm_subComponents :: [[T.Text] -> x] , pm_here :: [x] , pm_staticMap :: HM.HashMap T.Text (PathMap x)- , pm_polyMap :: PM.PolyMap PathPiece PathMap x+ , pm_polyMap :: PM.PolyMap FromHttpApiData PathMap x , pm_wildcards :: [T.Text -> x] } @@ -133,7 +133,7 @@ [] -> h ++ fmap ($ "") w (pp:pps) -> let staticMatches = maybeToList (HM.lookup pp s) >>= flip match pps- varMatches = PM.lookupConcat (fromPathPiece pp)+ varMatches = PM.lookupConcat (either (const Nothing) Just $ parseUrlPiece pp) (\piece pathMap' -> fmap ($ piece) (match pathMap' pps)) p routeRest = combineRoutePieces pieces wildcardMatches = fmap ($ routeRest) w@@ -160,12 +160,12 @@ then parse pathXs xs else Nothing PI_VarCons pathXs ->- case fromPathPiece pathComp of- Nothing -> Nothing- Just val ->+ case parseUrlPiece pathComp of+ Left _ -> Nothing+ Right val -> let finish = parse pathXs xs in fmap (\parsedXs -> val :&: parsedXs) finish PI_Wildcard PI_Empty ->- Just $ (combineRoutePieces pathComps) :&: HNil+ Just $ combineRoutePieces pathComps :&: HNil PI_Wildcard _ -> error "Shouldn't happen"
test/Spec.hs view
@@ -1,1 +1,9 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+module Main where++import qualified Web.Routing.SafeRoutingSpec++import Test.Hspec++main :: IO ()+main = hspec $+ Web.Routing.SafeRoutingSpec.spec