yesod-routes: removed yesod-core dependency
This commit is contained in:
parent
f909669dd0
commit
d69ee53a17
@ -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 <-
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user