don't bother with TH for static page routes

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.

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
     ]

yesod-core/test/YesodCoreTest/StaticPages.hs

@@ -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
-  ]

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

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

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