fixup slashes
This commit is contained in:
parent
4a2bff1c78
commit
2feecf317f
@ -17,6 +17,7 @@ import Language.Haskell.TH.Quote
|
|||||||
import qualified System.IO as SIO
|
import qualified System.IO as SIO
|
||||||
import Yesod.Routes.TH
|
import Yesod.Routes.TH
|
||||||
import Yesod.Routes.Overlap (findOverlapNames)
|
import Yesod.Routes.Overlap (findOverlapNames)
|
||||||
|
import System.FilePath.Posix ((</>))
|
||||||
|
|
||||||
-- | A quasi-quoter to parse a string into a list of 'Resource's. Checks for
|
-- | A quasi-quoter to parse a string into a list of 'Resource's. Checks for
|
||||||
-- overlapping routes, failing if present; use 'parseRoutesNoCheck' to skip the
|
-- overlapping routes, failing if present; use 'parseRoutesNoCheck' to skip the
|
||||||
@ -63,8 +64,9 @@ parseRoutePaths :: String -> [String]
|
|||||||
parseRoutePaths = parseRoutesFromString staticPageRoute
|
parseRoutePaths = parseRoutesFromString staticPageRoute
|
||||||
where
|
where
|
||||||
staticPageRoute :: String -> [String] -> Maybe String
|
staticPageRoute :: String -> [String] -> Maybe String
|
||||||
staticPageRoute r [] = Just r
|
staticPageRoute r [] = Just $ stripEndSlash r
|
||||||
staticPageRoute r rest = error $ "line starting with: " ++ r ++ "\ndid not expect: " ++ show rest
|
staticPageRoute r rest = error $ "line starting with: " ++ r ++ "\ndid not expect: " ++ show rest
|
||||||
|
stripEndSlash r = if last r == '/' then init r else r
|
||||||
|
|
||||||
-- | Convert a multi-line string to a set of resources. See documentation for
|
-- | 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
|
-- the format of this string. This is a partial function which calls 'error' on
|
||||||
@ -75,7 +77,7 @@ resourcesFromString =
|
|||||||
|
|
||||||
resourceFromLine :: String -> [String] -> Maybe (Resource String)
|
resourceFromLine :: String -> [String] -> Maybe (Resource String)
|
||||||
resourceFromLine fullRoute (constr:rest) =
|
resourceFromLine fullRoute (constr:rest) =
|
||||||
let (pieces, mmulti) = piecesFromString $ drop1Slash fullRoute
|
let (pieces, mmulti) = piecesFromString $ fullRoute
|
||||||
disp = dispatchFromString rest mmulti
|
disp = dispatchFromString rest mmulti
|
||||||
in Just $ Resource constr pieces disp
|
in Just $ Resource constr pieces disp
|
||||||
resourceFromLine _ [] = Nothing -- an indenter: there should be indented routes afterwards
|
resourceFromLine _ [] = Nothing -- an indenter: there should be indented routes afterwards
|
||||||
@ -99,17 +101,12 @@ parseRoutesFromString mkRoute =
|
|||||||
let (newNoIndent, fullRoute) =
|
let (newNoIndent, fullRoute) =
|
||||||
if indents l == 0
|
if indents l == 0
|
||||||
-- important: the check is done lazily
|
-- important: the check is done lazily
|
||||||
then (checkEndSlash route, route)
|
then (route, route)
|
||||||
else (noIndent, noIndent ++ route)
|
else (noIndent, noIndent </> route)
|
||||||
in mkRoute fullRoute rest : parseLines newNoIndent ls
|
in mkRoute (dropPreSlash fullRoute) rest : parseLines newNoIndent ls
|
||||||
[] -> parseLines noIndent ls
|
[] -> parseLines noIndent ls
|
||||||
parseLines _ [] = []
|
parseLines _ [] = []
|
||||||
|
|
||||||
checkEndSlash route =
|
|
||||||
if last route /= '/'
|
|
||||||
then error "the route indenter was expected to have a slash: " ++ route
|
|
||||||
else route
|
|
||||||
|
|
||||||
dispatchFromString :: [String] -> Maybe String -> Dispatch String
|
dispatchFromString :: [String] -> Maybe String -> Dispatch String
|
||||||
dispatchFromString rest mmulti
|
dispatchFromString rest mmulti
|
||||||
| null rest = Methods mmulti []
|
| null rest = Methods mmulti []
|
||||||
@ -120,9 +117,9 @@ dispatchFromString [_, _] Just{} =
|
|||||||
error "Subsites cannot have a multipiece"
|
error "Subsites cannot have a multipiece"
|
||||||
dispatchFromString rest _ = error $ "Invalid list of methods: " ++ show rest
|
dispatchFromString rest _ = error $ "Invalid list of methods: " ++ show rest
|
||||||
|
|
||||||
drop1Slash :: String -> String
|
dropPreSlash :: String -> String
|
||||||
drop1Slash ('/':x) = x
|
dropPreSlash ('/':x) = x
|
||||||
drop1Slash x = x
|
dropPreSlash x = x
|
||||||
|
|
||||||
piecesFromString :: String -> ([(CheckOverlap, Piece String)], Maybe String)
|
piecesFromString :: String -> ([(CheckOverlap, Piece String)], Maybe String)
|
||||||
piecesFromString "" = ([], Nothing)
|
piecesFromString "" = ([], Nothing)
|
||||||
|
|||||||
@ -228,7 +228,7 @@ main :: IO ()
|
|||||||
main = hspecX $ do
|
main = hspecX $ do
|
||||||
describe "parseRoutePaths" $
|
describe "parseRoutePaths" $
|
||||||
it "lists static page routes" $
|
it "lists static page routes" $
|
||||||
["/pages/","/pages/about","/pages/data","/pages/faq"] @=? parseRoutePaths (intercalate "\n" [
|
["pages","pages/about","pages/data","pages/faq"] @=? parseRoutePaths (intercalate "\n" [
|
||||||
"/pages/"
|
"/pages/"
|
||||||
," about"
|
," about"
|
||||||
," data"
|
," data"
|
||||||
|
|||||||
@ -19,6 +19,7 @@ library
|
|||||||
, containers >= 0.2 && < 0.5
|
, containers >= 0.2 && < 0.5
|
||||||
, template-haskell
|
, template-haskell
|
||||||
, path-pieces >= 0.1 && < 0.2
|
, path-pieces >= 0.1 && < 0.2
|
||||||
|
, filepath >= 1
|
||||||
|
|
||||||
exposed-modules: Yesod.Routes.Dispatch
|
exposed-modules: Yesod.Routes.Dispatch
|
||||||
Yesod.Routes.TH
|
Yesod.Routes.TH
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user