reroute 0.2.3.0 → 0.3.0.1
raw patch · 5 files changed
+39/−96 lines, 5 filesdep +hvect
Dependencies added: hvect
Files
- README.md +21/−0
- reroute.cabal +10/−5
- src/Data/HVect.hs +0/−84
- src/Web/Routing/SafeRouting.hs +7/−6
- test/Web/Routing/SafeRoutingSpec.hs +1/−1
+ README.md view
@@ -0,0 +1,21 @@+reroute+=====++[](https://travis-ci.org/agrafix/reroute)++[](http://packdeps.haskellers.com/reverse/reroute)++# Intro++Hackage: http://hackage.haskell.org/package/reroute++An abstract implementation of typesafe and untyped routing for web applications. The web framework+[Spock](https://github.com/agrafix/Spock) is implemented with it. The basic idea is you have a+registry storing a mapping betwenn abstract routes and actions. Then you define two methods for+adding a route and it's action to the registry and a second method for efficiently matching a+provided path to a route and multiple actions.++# Install++* Using cabal: `cabal install reroute`+* From Source: `git clone https://github.com/agrafix/reroute.git && cd reroute && cabal install`
reroute.cabal view
@@ -1,5 +1,5 @@ name: reroute-version: 0.2.3.0+version: 0.3.0.1 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/reroute@@ -12,9 +12,11 @@ build-type: Simple cabal-version: >=1.10 +extra-source-files:+ README.md+ library exposed-modules:- Data.HVect, Data.PolyMap, Web.Routing.AbstractRouter, Web.Routing.SafeRouting,@@ -30,7 +32,8 @@ text >= 0.11.3.1, transformers >=0.3, unordered-containers >=0.2,- vector >=0.10+ vector >=0.10,+ hvect >=0.1 hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall -fno-warn-orphans@@ -50,7 +53,8 @@ reroute, text, unordered-containers,- vector+ vector,+ hvect default-language: Haskell2010 ghc-options: -Wall -fno-warn-orphans @@ -72,7 +76,8 @@ random, deepseq, path-pieces,- graph-core+ graph-core,+ hvect source-repository head type: git
− src/Data/HVect.hs
@@ -1,84 +0,0 @@-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE UndecidableInstances #-} -- for ReverseLoop type family-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE KindSignatures #-}--module Data.HVect- ( HVect (..)- , HVectElim- , Append, hVectAppend- , ReverseLoop, Reverse, hVectReverse- , hVectUncurry- , Rep (..), HasRep (..)- , hVectCurryExpl, hVectCurry- , packExpl, pack- ) where--data HVect (ts :: [*]) where- HNil :: HVect '[]- HCons :: t -> HVect ts -> HVect (t ': ts)---- todo: use a closed type family once GHC 7.6 compatibility is dropped-type family HVectElim (ts :: [*]) (a :: *) :: *-type instance HVectElim '[] a = a-type instance HVectElim (t ': ts) a = t -> HVectElim ts a---- todo: use a closed type family once GHC 7.6 compatibility is dropped-type family Append (as :: [*]) (bs :: [*]) :: [*]-type instance Append '[] bs = bs-type instance Append (a ': as) bs = a ': (Append as bs)--hVectAppend :: HVect as -> HVect bs -> HVect (Append as bs)-hVectAppend HNil bs = bs-hVectAppend (HCons a as) bs = HCons a (hVectAppend as bs)--type family ReverseLoop (as :: [*]) (bs :: [*]) :: [*]-type instance ReverseLoop '[] bs = bs-type instance ReverseLoop (a ': as) bs = ReverseLoop as (a ': bs)--type Reverse as = ReverseLoop as '[]--hVectReverse :: HVect as -> HVect (Reverse as)-hVectReverse vs = go vs HNil- where- go :: HVect as -> HVect bs -> HVect (ReverseLoop as bs)- go HNil bs = bs- go (HCons a as) bs = go as (HCons a bs)--hVectUncurry :: HVectElim ts a -> HVect ts -> a-hVectUncurry f HNil = f-hVectUncurry f (HCons x xs) = hVectUncurry (f x) xs--data Rep (ts :: [*]) where- RNil :: Rep '[]- RCons :: Rep ts -> Rep (t ': ts)--class HasRep (ts :: [*]) where- hasRep :: Rep ts--instance HasRep '[] where- hasRep = RNil--instance HasRep ts => HasRep (t ': ts) where- hasRep = RCons hasRep--hVectCurryExpl :: Rep ts -> (HVect ts -> a) -> HVectElim ts a-hVectCurryExpl RNil f = f HNil-hVectCurryExpl (RCons r) f = \x -> hVectCurryExpl r (f . HCons x)--hVectCurry :: HasRep ts => (HVect ts -> a) -> HVectElim ts a-hVectCurry = hVectCurryExpl hasRep--buildElim :: Rep ts -> (HVect ts -> HVect ss) -> HVectElim ts (HVect ss)-buildElim RNil f = f HNil-buildElim (RCons r) f = \x -> buildElim r (f . HCons x)--packExpl :: Rep ts -> (forall a. HVectElim ts a -> a) -> HVect ts-packExpl rep f = f (buildElim rep id)--pack :: HasRep ts => (forall a. HVectElim ts a -> a) -> HVect ts-pack = packExpl hasRep
src/Web/Routing/SafeRouting.hs view
@@ -8,7 +8,8 @@ module Web.Routing.SafeRouting where import qualified Data.PolyMap as PM-import Data.HVect+import Data.HVect hiding (null)+import qualified Data.HVect as HV import Web.Routing.AbstractRouter import Data.Maybe@@ -104,15 +105,15 @@ let subPathMap = fromMaybe emptyPathMap (HM.lookup pathPiece s) in PathMap h (HM.insert pathPiece (insertPathMap' path' action subPathMap) s) p VarCons path' ->- let alterFn = Just . insertPathMap' path' (\vs v -> action (HCons v vs))+ let alterFn = Just . insertPathMap' path' (\vs v -> action (v :&: vs)) . fromMaybe emptyPathMap in PathMap h s (PM.alter alterFn p) singleton :: Path ts -> HVectElim ts x -> PathMap x-singleton path action = insertPathMap' path (hVectUncurry action) mempty+singleton path action = insertPathMap' path (HV.uncurry action) mempty insertPathMap :: RouteHandle m a -> PathMap (m a) -> PathMap (m a)-insertPathMap (RouteHandle path action) = insertPathMap' path (hVectUncurry action)+insertPathMap (RouteHandle path action) = insertPathMap' path (HV.uncurry action) match :: PathMap x -> [T.Text] -> [x] match (PathMap h _ _) [] = h@@ -154,7 +155,7 @@ renderRoute' Empty _ = [] renderRoute' (StaticCons pathPiece pathXs) paramXs = ( pathPiece : renderRoute' pathXs paramXs )-renderRoute' (VarCons pathXs) (HCons val paramXs) =+renderRoute' (VarCons pathXs) (val :&: paramXs) = ( toPathPiece val : renderRoute' pathXs paramXs) renderRoute' _ _ = error "This will never happen."@@ -174,4 +175,4 @@ Nothing -> Nothing Just val -> let finish = parse pathXs xs- in fmap (\parsedXs -> HCons val parsedXs) finish+ in fmap (\parsedXs -> val :&: parsedXs) finish
test/Web/Routing/SafeRoutingSpec.hs view
@@ -5,7 +5,7 @@ module Web.Routing.SafeRoutingSpec where import Test.Hspec-import Data.HVect+import Data.HVect hiding (singleton) import Control.Monad.Identity import Web.Routing.SafeRouting