diff --git a/reroute.cabal b/reroute.cabal --- a/reroute.cabal +++ b/reroute.cabal @@ -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 , Tim Baumann maintainer: Alexander Thiemann -copyright: (c) 2014 - 2016 Alexander Thiemann , Tim Baumann +copyright: (c) 2014 - 2017 Alexander Thiemann , Tim Baumann 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 diff --git a/src/Web/Routing/Combinators.hs b/src/Web/Routing/Combinators.hs --- a/src/Web/Routing/Combinators.hs +++ b/src/Web/Routing/Combinators.hs @@ -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." diff --git a/src/Web/Routing/SafeRouting.hs b/src/Web/Routing/SafeRouting.hs --- a/src/Web/Routing/SafeRouting.hs +++ b/src/Web/Routing/SafeRouting.hs @@ -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" diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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