diff --git a/yesod-core/Yesod/Dispatch.hs b/yesod-core/Yesod/Dispatch.hs index 627f011a..a7f33d79 100644 --- a/yesod-core/Yesod/Dispatch.hs +++ b/yesod-core/Yesod/Dispatch.hs @@ -14,7 +14,6 @@ module Yesod.Dispatch , mkYesodSubData , mkYesodDispatch , mkYesodSubDispatch - , mkYesodStaticPages -- ** Path pieces , PathPiece (..) , PathMultiPiece (..) @@ -50,29 +49,9 @@ import Network.HTTP.Types (status301) import Yesod.Routes.TH import Yesod.Content (chooseRep) import Yesod.Routes.Parse -import Data.List (partition) type Texts = [Text] -mkYesodStaticPages :: String -> [StaticPageRoute] -> Q [Dec] -mkYesodStaticPages name routes = - let (staticGets, staticResources) = partition isGet routes - gets = ListE (map (LitE . StringL . toString) staticGets) - getsD = ValD (VarP (mkName "staticPageRoutePaths")) (NormalB gets) [] - in do yesod <- mkYesod name (map toResource staticResources) - return $ [getsD] ++ yesod - - where - isGet (StaticGet _) = True - isGet (StaticResource _) = False - toResource (StaticResource r) = r - toResource (StaticGet _) = error "expected resource" - toString (StaticGet str) = dropSlashes str - toString (StaticResource _) = error "did not expect resource" - dropSlashes str | last str == '/' = dropSlashes $ init str - | head str == '/' = dropSlashes $ tail str - | otherwise = str - -- | Generates URL datatype and site function for the given 'Resource's. This -- is used for creating sites, /not/ subsites. See 'mkYesodSub' for the latter. -- Use 'parseRoutes' to create the 'Resource's. diff --git a/yesod-core/test/YesodCoreTest.hs b/yesod-core/test/YesodCoreTest.hs index 9eb2a84d..9a1d23c7 100644 --- a/yesod-core/test/YesodCoreTest.hs +++ b/yesod-core/test/YesodCoreTest.hs @@ -10,7 +10,6 @@ import YesodCoreTest.InternalRequest import YesodCoreTest.ErrorHandling import YesodCoreTest.Cache import qualified YesodCoreTest.Redirect as Redirect -import qualified YesodCoreTest.StaticPages as StaticPages import Test.Hspec @@ -26,5 +25,4 @@ specs = , errorHandlingTest , cacheTest , Redirect.specs - , StaticPages.specs ] diff --git a/yesod-core/test/YesodCoreTest/StaticPages.hs b/yesod-core/test/YesodCoreTest/StaticPages.hs deleted file mode 100644 index b2b510ab..00000000 --- a/yesod-core/test/YesodCoreTest/StaticPages.hs +++ /dev/null @@ -1,33 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-unused-binds #-} -{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} -module YesodCoreTest.StaticPages (specs) where - -import Test.Hspec -import Test.Hspec.HUnit () -import Test.HUnit - -import Yesod.Core -import Yesod.Routes.Parse (staticPageRoutes) - -data StaticPages = StaticPages - -mkYesodStaticPages "StaticPages" [staticPageRoutes| -/pages/ PageR -/pages/ - about - data - faq -|] - -instance Yesod StaticPages where approot _ = "" - -handlePageR :: Handler RepHtml -handlePageR = defaultLayout [whamlet|Hello World!|] - -specs :: [Spec] -specs = describe "staticPageRoutePaths" [ - it "lists static page routes" $ - ["pages","pages/about","pages/data","pages/faq"] @=? staticPageRoutePaths - ] diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal index b1cb3bf5..005d1e21 100644 --- a/yesod-core/yesod-core.cabal +++ b/yesod-core/yesod-core.cabal @@ -127,7 +127,6 @@ test-suite tests , random ,HUnit ,QuickCheck >= 2 && < 3 - , yesod-routes >= 0.0 && < 0.1 ghc-options: -Wall source-repository head diff --git a/yesod-routes/Yesod/Routes/Parse.hs b/yesod-routes/Yesod/Routes/Parse.hs index 2dc93df7..e76aa21f 100644 --- a/yesod-routes/Yesod/Routes/Parse.hs +++ b/yesod-routes/Yesod/Routes/Parse.hs @@ -7,15 +7,12 @@ module Yesod.Routes.Parse , parseRoutesNoCheck , parseRoutesFileNoCheck , parseType - , staticPageRoutes - , staticPageRoutesFile - , StaticPageRoute (..) + , parseRoutePaths ) where import Language.Haskell.TH.Syntax import Data.Maybe import Data.Char (isUpper, isSpace) -import Data.List (intercalate) import Language.Haskell.TH.Quote import qualified System.IO as SIO import Yesod.Routes.TH @@ -55,37 +52,26 @@ parseRoutesNoCheck :: QuasiQuoter parseRoutesNoCheck = QuasiQuoter { quoteExp = lift . resourcesFromString } --- | QuasiQuoter for 'staticPageRoutesFromString' -staticPageRoutes :: QuasiQuoter -staticPageRoutes = QuasiQuoter - { quoteExp = lift . staticPageRoutesFromString } - --- | parse a file with 'staticPageRoutesFromString' -staticPageRoutesFile :: FilePath -> Q Exp -staticPageRoutesFile fp = do - s <- qRunIO $ readUtf8File fp - quoteExp staticPageRoutes s - -data StaticPageRoute = StaticGet String | StaticResource (Resource String) -instance Lift StaticPageRoute where - lift (StaticGet str) = [|StaticGet $(lift str)|] - lift (StaticResource r) = [|StaticResource $(lift r)|] - --- | Convert a multi-line string to a set of routes. --- like normal route parsing, but there are just route paths, no route constructors +-- | Convert a multi-line string to a set of route paths. +-- like normal route parsing, but there are just route paths, no route constructors or HTTP methods +-- This can be used as a DSL for generating route paths that +-- * closely matches your current routes file +-- * allows indentation to imply prefixes +-- -- This is a partial function which calls 'error' on invalid input. -staticPageRoutesFromString :: String -> [StaticPageRoute] -staticPageRoutesFromString = parseRoutesFromString staticPageRoute +parseRoutePaths :: String -> [String] +parseRoutePaths = parseRoutesFromString staticPageRoute where - staticPageRoute r [] = Just (StaticGet r) - staticPageRoute r rest = fmap StaticResource $ resourceFromLine r rest + staticPageRoute :: String -> [String] -> Maybe String + staticPageRoute r [] = Just r + staticPageRoute r rest = error $ "line starting with: " ++ r ++ "\ndid not expect: " ++ show rest -- | Convert a multi-line string to a set of resources. See documentation for -- the format of this string. This is a partial function which calls 'error' on -- invalid input. resourcesFromString :: String -> [Resource String] resourcesFromString = - parseRoutesFromString justResourceFromLine + parseRoutesFromString resourceFromLine resourceFromLine :: String -> [String] -> Maybe (Resource String) resourceFromLine fullRoute (constr:rest) = @@ -95,12 +81,6 @@ resourceFromLine fullRoute (constr:rest) = resourceFromLine _ [] = Nothing -- an indenter: there should be indented routes afterwards -justResourceFromLine :: String -> [String] -> Maybe (Resource String) -justResourceFromLine x xs = - case resourceFromLine x xs of - Nothing -> error $ "Invalid resource line: " ++ (intercalate " " (x:xs)) - r -> r - -- | used by 'resourcesFromString' and 'staticPageRoutesFromString' parseRoutesFromString :: (String -- ^ route pattern -> [String] -- ^ extra diff --git a/yesod-routes/test/main.hs b/yesod-routes/test/main.hs index af73aa09..14491064 100644 --- a/yesod-routes/test/main.hs +++ b/yesod-routes/test/main.hs @@ -10,16 +10,17 @@ {-# LANGUAGE CPP #-} import Test.Hspec.Monadic import Test.Hspec.HUnit () -import Test.HUnit ((@?=)) +import Test.HUnit ((@?=), (@=?)) import Data.Text (Text, pack, unpack, singleton) 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 Yesod.Routes.Parse (parseRoutesNoCheck) +import Yesod.Routes.Parse (parseRoutesNoCheck, parseRoutePaths) import Yesod.Routes.Overlap (findOverlapNames) import Yesod.Routes.TH hiding (Dispatch) import Language.Haskell.TH.Syntax +import Data.List (intercalate) class ToText a where toText :: a -> Text @@ -224,7 +225,15 @@ thDispatchAlias master sub toMaster app404 handler405 method0 pieces0 = -} main :: IO () -main = hspecX $ do +main = hspecX $ do + describe "parseRoutePaths" $ + it "lists static page routes" $ + ["/pages/","/pages/about","/pages/data","/pages/faq"] @=? parseRoutePaths (intercalate "\n" [ + "/pages/" + ," about" + ," data" + ," faq" + ]) describe "justRoot" $ do it "dispatches correctly" $ test justRoot [] @?= Just 1 it "fails correctly" $ test justRoot ["foo"] @?= Nothing