yesod-routes: removed yesod-core dependency

This commit is contained in:
Michael Snoyman 2012-01-01 17:32:25 +02:00
parent f909669dd0
commit d69ee53a17
3 changed files with 16 additions and 17 deletions

View File

@ -16,15 +16,14 @@ module Yesod.Routes.TH
) where ) where
import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax
import Yesod.Core
( Route, RenderRoute (renderRoute), toSinglePiece, toMultiPiece
)
import Data.Maybe (maybeToList, catMaybes) import Data.Maybe (maybeToList, catMaybes)
import Control.Monad (replicateM) import Control.Monad (replicateM)
import Data.Text (pack) import Data.Text (pack)
import qualified Yesod.Routes.Dispatch as D import qualified Yesod.Routes.Dispatch as D
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Char (toLower) import Data.Char (toLower)
import Web.PathPieces (PathPiece (..), PathMultiPiece (..))
import Yesod.Routes.Class
data Resource = Resource data Resource = Resource
{ resourceName :: String { resourceName :: String
@ -85,14 +84,14 @@ mkRenderRouteClauses =
let pat = ConP (mkName $ resourceName res) $ map VarP $ dyns ++ sub let pat = ConP (mkName $ resourceName res) $ map VarP $ dyns ++ sub
pack <- [|pack|] pack <- [|pack|]
tsp <- [|toSinglePiece|] tsp <- [|toPathPiece|]
let piecesSingle = mkPieces (AppE pack . LitE . StringL) tsp (resourcePieces res) dyns let piecesSingle = mkPieces (AppE pack . LitE . StringL) tsp (resourcePieces res) dyns
piecesMulti <- piecesMulti <-
case resourceMulti res of case resourceMulti res of
Nothing -> return $ ListE [] Nothing -> return $ ListE []
Just{} -> do Just{} -> do
tmp <- [|toMultiPiece|] tmp <- [|toPathMultiPiece|]
return $ tmp `AppE` VarE (last dyns) return $ tmp `AppE` VarE (last dyns)
body <- body <-

View File

@ -1,14 +1,16 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
import Test.Hspec.Monadic import Test.Hspec.Monadic
import Test.Hspec.HUnit () import Test.Hspec.HUnit ()
import Test.HUnit ((@?=)) import Test.HUnit ((@?=))
import Data.Text (Text, unpack) import Data.Text (Text, unpack)
import Yesod.Routes.Dispatch hiding (Static, Dynamic) import Yesod.Routes.Dispatch hiding (Static, Dynamic)
import Yesod.Routes.Class hiding (Route)
import qualified Yesod.Routes.Class as YRC
import qualified Yesod.Routes.Dispatch as D import qualified Yesod.Routes.Dispatch as D
import Yesod.Routes.TH hiding (Dispatch) import Yesod.Routes.TH hiding (Dispatch)
import qualified Yesod.Core as YC
import Language.Haskell.TH.Syntax import Language.Haskell.TH.Syntax
import qualified Data.Map as Map import qualified Data.Map as Map
@ -55,10 +57,9 @@ test :: Dispatch () Int -> [Text] -> Maybe Int
test dispatch ts = dispatch ts () test dispatch ts = dispatch ts ()
data MySub = MySub data MySub = MySub
data MySubRoute = MySubRoute ([Text], [(Text, Text)]) data instance YRC.Route MySub = MySubRoute ([Text], [(Text, Text)])
deriving (Show, Read, Eq) deriving (Show, Eq, Read)
type instance YC.Route MySub = MySubRoute instance RenderRoute (YRC.Route MySub) where
instance YC.RenderRoute MySubRoute where
renderRoute (MySubRoute x) = x renderRoute (MySubRoute x) = x
dispatchHelper :: Either String (Map.Map Text String) -> Maybe String dispatchHelper :: Either String (Map.Map Text String) -> Maybe String
@ -110,10 +111,10 @@ main = hspecX $ do
it "dispatches correctly to []" $ test overlap [] @?= Just 22 it "dispatches correctly to []" $ test overlap [] @?= Just 22
describe "RenderRoute instance" $ do describe "RenderRoute instance" $ do
it "renders root correctly" $ YC.renderRoute RootR @?= ([], []) it "renders root correctly" $ renderRoute RootR @?= ([], [])
it "renders blog post correctly" $ YC.renderRoute (BlogPostR "foo") @?= (["blog", "foo"], []) it "renders blog post correctly" $ renderRoute (BlogPostR "foo") @?= (["blog", "foo"], [])
it "renders wiki correctly" $ YC.renderRoute (WikiR ["foo", "bar"]) @?= (["wiki", "foo", "bar"], []) it "renders wiki correctly" $ renderRoute (WikiR ["foo", "bar"]) @?= (["wiki", "foo", "bar"], [])
it "renders subsite correctly" $ YC.renderRoute (SubsiteR $ MySubRoute (["foo", "bar"], [("baz", "bin")])) it "renders subsite correctly" $ renderRoute (SubsiteR $ MySubRoute (["foo", "bar"], [("baz", "bin")]))
@?= (["subsite", "foo", "bar"], [("baz", "bin")]) @?= (["subsite", "foo", "bar"], [("baz", "bin")])
describe "thDispatch" $ do describe "thDispatch" $ do

View File

@ -13,15 +13,15 @@ homepage: http://www.yesodweb.com/
library library
build-depends: base >= 4 && < 5 build-depends: base >= 4 && < 5
, yesod-core >= 0.9.3 && < 0.10
, text >= 0.5 && < 0.12 , text >= 0.5 && < 0.12
, vector >= 0.8 && < 0.10 , vector >= 0.8 && < 0.10
, clientsession >= 0.7 && < 0.8
, containers >= 0.2 && < 0.5 , containers >= 0.2 && < 0.5
, template-haskell , template-haskell
, path-pieces >= 0.1 && < 0.2
exposed-modules: Yesod.Routes.Dispatch exposed-modules: Yesod.Routes.Dispatch
Yesod.Routes.TH Yesod.Routes.TH
Yesod.Routes.Class
ghc-options: -Wall ghc-options: -Wall
test-suite runtests test-suite runtests
@ -34,7 +34,6 @@ test-suite runtests
, text >= 0.5 && < 0.12 , text >= 0.5 && < 0.12
, HUnit >= 1.2 && < 1.3 , HUnit >= 1.2 && < 1.3
, hspec >= 0.6 && < 0.10 , hspec >= 0.6 && < 0.10
, yesod-core >= 0.9.3 && < 0.10
, containers , containers
, template-haskell , template-haskell
ghc-options: -Wall ghc-options: -Wall