diff options
Diffstat (limited to 'standalone/android/haskell-patches/yesod-routes_1.1.2_0001-remove-TH-and-export-module-used-by-TH-splices.patch')
| -rw-r--r-- | standalone/android/haskell-patches/yesod-routes_1.1.2_0001-remove-TH-and-export-module-used-by-TH-splices.patch | 674 |
1 files changed, 0 insertions, 674 deletions
diff --git a/standalone/android/haskell-patches/yesod-routes_1.1.2_0001-remove-TH-and-export-module-used-by-TH-splices.patch b/standalone/android/haskell-patches/yesod-routes_1.1.2_0001-remove-TH-and-export-module-used-by-TH-splices.patch deleted file mode 100644 index 33bcff447..000000000 --- a/standalone/android/haskell-patches/yesod-routes_1.1.2_0001-remove-TH-and-export-module-used-by-TH-splices.patch +++ /dev/null @@ -1,674 +0,0 @@ -From 06176b0f3dbbe559490f0971e0db205287793286 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Mon, 15 Apr 2013 21:01:12 -0400 -Subject: [PATCH] remove TH and export module used by TH splices - ---- - Yesod/Routes/Overlap.hs | 74 ---------- - Yesod/Routes/Parse.hs | 115 --------------- - Yesod/Routes/TH.hs | 12 -- - Yesod/Routes/TH/Dispatch.hs | 344 -------------------------------------------- - Yesod/Routes/TH/Types.hs | 16 --- - yesod-routes.cabal | 21 --- - 6 files changed, 582 deletions(-) - delete mode 100644 Yesod/Routes/Overlap.hs - delete mode 100644 Yesod/Routes/Parse.hs - delete mode 100644 Yesod/Routes/TH.hs - delete mode 100644 Yesod/Routes/TH/Dispatch.hs - -diff --git a/Yesod/Routes/Overlap.hs b/Yesod/Routes/Overlap.hs -deleted file mode 100644 -index ae45a02..0000000 ---- a/Yesod/Routes/Overlap.hs -+++ /dev/null -@@ -1,74 +0,0 @@ ---- | Check for overlapping routes. --module Yesod.Routes.Overlap -- ( findOverlaps -- , findOverlapNames -- , Overlap (..) -- ) where -- --import Yesod.Routes.TH.Types --import Data.List (intercalate) -- --data Overlap t = Overlap -- { overlapParents :: [String] -> [String] -- ^ parent resource trees -- , overlap1 :: ResourceTree t -- , overlap2 :: ResourceTree t -- } -- --findOverlaps :: ([String] -> [String]) -> [ResourceTree t] -> [Overlap t] --findOverlaps _ [] = [] --findOverlaps front (x:xs) = concatMap (findOverlap front x) xs ++ findOverlaps front xs -- --findOverlap :: ([String] -> [String]) -> ResourceTree t -> ResourceTree t -> [Overlap t] --findOverlap front x y = -- here rest -- where -- here -- | overlaps (resourceTreePieces x) (resourceTreePieces y) (hasSuffix x) (hasSuffix y) = (Overlap front x y:) -- | otherwise = id -- rest = -- case x of -- ResourceParent name _ children -> findOverlaps (front . (name:)) children -- ResourceLeaf{} -> [] -- --hasSuffix :: ResourceTree t -> Bool --hasSuffix (ResourceLeaf r) = -- case resourceDispatch r of -- Subsite{} -> True -- Methods Just{} _ -> True -- Methods Nothing _ -> False --hasSuffix ResourceParent{} = True -- --overlaps :: [(CheckOverlap, Piece t)] -> [(CheckOverlap, Piece t)] -> Bool -> Bool -> Bool -- ---- No pieces on either side, will overlap regardless of suffix --overlaps [] [] _ _ = True -- ---- No pieces on the left, will overlap if the left side has a suffix --overlaps [] _ suffixX _ = suffixX -- ---- Ditto for the right --overlaps _ [] _ suffixY = suffixY -- ---- As soon as we ignore a single piece (via CheckOverlap == False), we say that ---- the routes don't overlap at all. In other words, disabling overlap checking ---- on a single piece disables it on the whole route. --overlaps ((False, _):_) _ _ _ = False --overlaps _ ((False, _):_) _ _ = False -- ---- Compare the actual pieces --overlaps ((True, pieceX):xs) ((True, pieceY):ys) suffixX suffixY = -- piecesOverlap pieceX pieceY && overlaps xs ys suffixX suffixY -- --piecesOverlap :: Piece t -> Piece t -> Bool ---- Statics only match if they equal. Dynamics match with anything --piecesOverlap (Static x) (Static y) = x == y --piecesOverlap _ _ = True -- --findOverlapNames :: [ResourceTree t] -> [(String, String)] --findOverlapNames = -- map go . findOverlaps id -- where -- go (Overlap front x y) = -- (go' $ resourceTreeName x, go' $ resourceTreeName y) -- where -- go' = intercalate "/" . front . return -diff --git a/Yesod/Routes/Parse.hs b/Yesod/Routes/Parse.hs -deleted file mode 100644 -index fc16eef..0000000 ---- a/Yesod/Routes/Parse.hs -+++ /dev/null -@@ -1,115 +0,0 @@ --{-# LANGUAGE TemplateHaskell #-} --{-# LANGUAGE DeriveDataTypeable #-} --{-# OPTIONS_GHC -fno-warn-missing-fields #-} -- QuasiQuoter --module Yesod.Routes.Parse -- ( parseRoutes -- , parseRoutesFile -- , parseRoutesNoCheck -- , parseRoutesFileNoCheck -- , parseType -- ) where -- --import Language.Haskell.TH.Syntax --import Data.Char (isUpper) --import Language.Haskell.TH.Quote --import qualified System.IO as SIO --import Yesod.Routes.TH --import Yesod.Routes.Overlap (findOverlapNames) -- ---- | 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 ---- checking. See documentation site for details on syntax. --parseRoutes :: QuasiQuoter --parseRoutes = QuasiQuoter { quoteExp = x } -- where -- x s = do -- let res = resourcesFromString s -- case findOverlapNames res of -- [] -> lift res -- z -> error $ "Overlapping routes: " ++ unlines (map show z) -- --parseRoutesFile :: FilePath -> Q Exp --parseRoutesFile = parseRoutesFileWith parseRoutes -- --parseRoutesFileNoCheck :: FilePath -> Q Exp --parseRoutesFileNoCheck = parseRoutesFileWith parseRoutesNoCheck -- --parseRoutesFileWith :: QuasiQuoter -> FilePath -> Q Exp --parseRoutesFileWith qq fp = do -- s <- qRunIO $ readUtf8File fp -- quoteExp qq s -- --readUtf8File :: FilePath -> IO String --readUtf8File fp = do -- h <- SIO.openFile fp SIO.ReadMode -- SIO.hSetEncoding h SIO.utf8_bom -- SIO.hGetContents h -- ---- | Same as 'parseRoutes', but performs no overlap checking. --parseRoutesNoCheck :: QuasiQuoter --parseRoutesNoCheck = QuasiQuoter -- { quoteExp = lift . resourcesFromString -- } -- ---- | 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 -> [ResourceTree String] --resourcesFromString = -- fst . parse 0 . lines -- where -- parse _ [] = ([], []) -- parse indent (thisLine:otherLines) -- | length spaces < indent = ([], thisLine : otherLines) -- | otherwise = (this others, remainder) -- where -- spaces = takeWhile (== ' ') thisLine -- (others, remainder) = parse indent otherLines' -- (this, otherLines') = -- case takeWhile (/= "--") $ words thisLine of -- [pattern, constr] | last constr == ':' -> -- let (children, otherLines'') = parse (length spaces + 1) otherLines -- (pieces, Nothing) = piecesFromString $ drop1Slash pattern -- in ((ResourceParent (init constr) pieces children :), otherLines'') -- (pattern:constr:rest) -> -- let (pieces, mmulti) = piecesFromString $ drop1Slash pattern -- disp = dispatchFromString rest mmulti -- in ((ResourceLeaf (Resource constr pieces disp):), otherLines) -- [] -> (id, otherLines) -- _ -> error $ "Invalid resource line: " ++ thisLine -- --dispatchFromString :: [String] -> Maybe String -> Dispatch String --dispatchFromString rest mmulti -- | null rest = Methods mmulti [] -- | all (all isUpper) rest = Methods mmulti rest --dispatchFromString [subTyp, subFun] Nothing = -- Subsite subTyp subFun --dispatchFromString [_, _] Just{} = -- error "Subsites cannot have a multipiece" --dispatchFromString rest _ = error $ "Invalid list of methods: " ++ show rest -- --drop1Slash :: String -> String --drop1Slash ('/':x) = x --drop1Slash x = x -- --piecesFromString :: String -> ([(CheckOverlap, Piece String)], Maybe String) --piecesFromString "" = ([], Nothing) --piecesFromString x = -- case (this, rest) of -- (Left typ, ([], Nothing)) -> ([], Just typ) -- (Left _, _) -> error "Multipiece must be last piece" -- (Right piece, (pieces, mtyp)) -> (piece:pieces, mtyp) -- where -- (y, z) = break (== '/') x -- this = pieceFromString y -- rest = piecesFromString $ drop 1 z -- --parseType :: String -> Type --parseType = ConT . mkName -- FIXME handle more complicated stuff -- --pieceFromString :: String -> Either String (CheckOverlap, Piece String) --pieceFromString ('#':'!':x) = Right $ (False, Dynamic x) --pieceFromString ('#':x) = Right $ (True, Dynamic x) --pieceFromString ('*':x) = Left x --pieceFromString ('!':x) = Right $ (False, Static x) --pieceFromString x = Right $ (True, Static x) -diff --git a/Yesod/Routes/TH.hs b/Yesod/Routes/TH.hs -deleted file mode 100644 -index 41045b3..0000000 ---- a/Yesod/Routes/TH.hs -+++ /dev/null -@@ -1,12 +0,0 @@ --{-# LANGUAGE TemplateHaskell #-} --module Yesod.Routes.TH -- ( module Yesod.Routes.TH.Types -- -- * Functions -- , module Yesod.Routes.TH.RenderRoute -- -- ** Dispatch -- , module Yesod.Routes.TH.Dispatch -- ) where -- --import Yesod.Routes.TH.Types --import Yesod.Routes.TH.RenderRoute --import Yesod.Routes.TH.Dispatch -diff --git a/Yesod/Routes/TH/Dispatch.hs b/Yesod/Routes/TH/Dispatch.hs -deleted file mode 100644 -index a52f69a..0000000 ---- a/Yesod/Routes/TH/Dispatch.hs -+++ /dev/null -@@ -1,344 +0,0 @@ --{-# LANGUAGE TemplateHaskell #-} --module Yesod.Routes.TH.Dispatch -- ( -- ** Dispatch -- mkDispatchClause -- ) where -- --import Prelude hiding (exp) --import Yesod.Routes.TH.Types --import Language.Haskell.TH.Syntax --import Data.Maybe (catMaybes) --import Control.Monad (forM, replicateM) --import Data.Text (pack) --import qualified Yesod.Routes.Dispatch as D --import qualified Data.Map as Map --import Data.Char (toLower) --import Web.PathPieces (PathPiece (..), PathMultiPiece (..)) --import Control.Applicative ((<$>)) --import Data.List (foldl') -- --data FlatResource a = FlatResource [(String, [(CheckOverlap, Piece a)])] String [(CheckOverlap, Piece a)] (Dispatch a) -- --flatten :: [ResourceTree a] -> [FlatResource a] --flatten = -- concatMap (go id) -- where -- go front (ResourceLeaf (Resource a b c)) = [FlatResource (front []) a b c] -- go front (ResourceParent name pieces children) = -- concatMap (go (front . ((name, pieces):))) children -- ---- | ---- ---- This function will generate a single clause that will address all ---- your routing needs. It takes four arguments. The fourth (a list of ---- 'Resource's) is self-explanatory. We\'ll discuss the first ---- three. But first, let\'s cover the terminology. ---- ---- Dispatching involves a master type and a sub type. When you dispatch to the ---- top level type, master and sub are the same. Each time to dispatch to ---- another subsite, the sub changes. This requires two changes: ---- ---- * Getting the new sub value. This is handled via 'subsiteFunc'. ---- ---- * Figure out a way to convert sub routes to the original master route. To ---- address this, we keep a toMaster function, and each time we dispatch to a ---- new subsite, we compose it with the constructor for that subsite. ---- ---- Dispatching acts on two different components: the request method and a list ---- of path pieces. If we cannot match the path pieces, we need to return a 404 ---- response. If the path pieces match, but the method is not supported, we need ---- to return a 405 response. ---- ---- The final result of dispatch is going to be an application type. A simple ---- example would be the WAI Application type. However, our handler functions ---- will need more input: the master/subsite, the toMaster function, and the ---- type-safe route. Therefore, we need to have another type, the handler type, ---- and a function that turns a handler into an application, i.e. ---- ---- > runHandler :: handler sub master -> master -> sub -> Route sub -> (Route sub -> Route master) -> app ---- ---- This is the first argument to our function. Note that this will almost ---- certainly need to be a method of a typeclass, since it will want to behave ---- differently based on the subsite. ---- ---- Note that the 404 response passed in is an application, while the 405 ---- response is a handler, since the former can\'t be passed the type-safe ---- route. ---- ---- In the case of a subsite, we don\'t directly deal with a handler function. ---- Instead, we redispatch to the subsite, passing on the updated sub value and ---- toMaster function, as well as any remaining, unparsed path pieces. This ---- function looks like: ---- ---- > dispatcher :: master -> sub -> (Route sub -> Route master) -> app -> handler sub master -> Text -> [Text] -> app ---- ---- Where the parameters mean master, sub, toMaster, 404 response, 405 response, ---- request method and path pieces. This is the second argument of our function. ---- ---- Finally, we need a way to decide which of the possible formats ---- should the handler send the data out. Think of each URL holding an ---- abstract object which has multiple representation (JSON, plain HTML ---- etc). Each client might have a preference on which format it wants ---- the abstract object in. For example, a javascript making a request ---- (on behalf of a browser) might prefer a JSON object over a plain ---- HTML file where as a user browsing with javascript disabled would ---- want the page in HTML. The third argument is a function that ---- converts the abstract object to the desired representation ---- depending on the preferences sent by the client. ---- ---- The typical values for the first three arguments are, ---- @'yesodRunner'@ for the first, @'yesodDispatch'@ for the second and ---- @fmap 'chooseRep'@. -- --mkDispatchClause :: Q Exp -- ^ runHandler function -- -> Q Exp -- ^ dispatcher function -- -> Q Exp -- ^ fixHandler function -- -> [ResourceTree a] -- -> Q Clause --mkDispatchClause runHandler dispatcher fixHandler ress' = do -- -- Allocate the names to be used. Start off with the names passed to the -- -- function itself (with a 0 suffix). -- -- -- -- We don't reuse names so as to avoid shadowing names (triggers warnings -- -- with -Wall). Additionally, we want to ensure that none of the code -- -- passed to toDispatch uses variables from the closure to prevent the -- -- dispatch data structure from being rebuilt on each run. -- master0 <- newName "master0" -- sub0 <- newName "sub0" -- toMaster0 <- newName "toMaster0" -- app4040 <- newName "app4040" -- handler4050 <- newName "handler4050" -- method0 <- newName "method0" -- pieces0 <- newName "pieces0" -- -- -- Name of the dispatch function -- dispatch <- newName "dispatch" -- -- -- Dispatch function applied to the pieces -- let dispatched = VarE dispatch `AppE` VarE pieces0 -- -- -- The 'D.Route's used in the dispatch function -- routes <- mapM (buildRoute runHandler dispatcher fixHandler) ress -- -- -- The dispatch function itself -- toDispatch <- [|D.toDispatch|] -- let dispatchFun = FunD dispatch [Clause [] (NormalB $ toDispatch `AppE` ListE routes) []] -- -- -- The input to the clause. -- let pats = map VarP [master0, sub0, toMaster0, app4040, handler4050, method0, pieces0] -- -- -- For each resource that dispatches based on methods, build up a map for handling the dispatching. -- methodMaps <- catMaybes <$> mapM (buildMethodMap fixHandler) ress -- -- u <- [|case $(return dispatched) of -- Just f -> f $(return $ VarE master0) -- $(return $ VarE sub0) -- $(return $ VarE toMaster0) -- $(return $ VarE app4040) -- $(return $ VarE handler4050) -- $(return $ VarE method0) -- Nothing -> $(return $ VarE app4040) -- |] -- return $ Clause pats (NormalB u) $ dispatchFun : methodMaps -- where -- ress = flatten ress' -- ---- | Determine the name of the method map for a given resource name. --methodMapName :: String -> Name --methodMapName s = mkName $ "methods" ++ s -- --buildMethodMap :: Q Exp -- ^ fixHandler -- -> FlatResource a -- -> Q (Maybe Dec) --buildMethodMap _ (FlatResource _ _ _ (Methods _ [])) = return Nothing -- single handle function --buildMethodMap fixHandler (FlatResource parents name pieces' (Methods mmulti methods)) = do -- fromList <- [|Map.fromList|] -- methods' <- mapM go methods -- let exp = fromList `AppE` ListE methods' -- let fun = FunD (methodMapName name) [Clause [] (NormalB exp) []] -- return $ Just fun -- where -- pieces = concat $ map snd parents ++ [pieces'] -- go method = do -- fh <- fixHandler -- let func = VarE $ mkName $ map toLower method ++ name -- pack' <- [|pack|] -- let isDynamic Dynamic{} = True -- isDynamic _ = False -- let argCount = length (filter (isDynamic . snd) pieces) + maybe 0 (const 1) mmulti -- xs <- replicateM argCount $ newName "arg" -- let rhs = LamE (map VarP xs) $ fh `AppE` (foldl' AppE func $ map VarE xs) -- return $ TupE [pack' `AppE` LitE (StringL method), rhs] --buildMethodMap _ (FlatResource _ _ _ Subsite{}) = return Nothing -- ---- | Build a single 'D.Route' expression. --buildRoute :: Q Exp -> Q Exp -> Q Exp -> FlatResource a -> Q Exp --buildRoute runHandler dispatcher fixHandler (FlatResource parents name resPieces resDisp) = do -- -- First two arguments to D.Route -- routePieces <- ListE <$> mapM (convertPiece . snd) allPieces -- isMulti <- -- case resDisp of -- Methods Nothing _ -> [|False|] -- _ -> [|True|] -- -- [|D.Route $(return routePieces) $(return isMulti) $(routeArg3 runHandler dispatcher fixHandler parents name (map snd allPieces) resDisp)|] -- where -- allPieces = concat $ map snd parents ++ [resPieces] -- --routeArg3 :: Q Exp -- ^ runHandler -- -> Q Exp -- ^ dispatcher -- -> Q Exp -- ^ fixHandler -- -> [(String, [(CheckOverlap, Piece a)])] -- -> String -- ^ name of resource -- -> [Piece a] -- -> Dispatch a -- -> Q Exp --routeArg3 runHandler dispatcher fixHandler parents name resPieces resDisp = do -- pieces <- newName "pieces" -- -- -- Allocate input piece variables (xs) and variables that have been -- -- converted via fromPathPiece (ys) -- xs <- forM resPieces $ \piece -> -- case piece of -- Static _ -> return Nothing -- Dynamic _ -> Just <$> newName "x" -- -- -- Note: the zipping with Ints is just a workaround for (apparently) a bug -- -- in GHC where the identifiers are considered to be overlapping. Using -- -- newName should avoid the problem, but it doesn't. -- ys <- forM (zip (catMaybes xs) [1..]) $ \(x, i) -> do -- y <- newName $ "y" ++ show (i :: Int) -- return (x, y) -- -- -- In case we have multi pieces at the end -- xrest <- newName "xrest" -- yrest <- newName "yrest" -- -- -- Determine the pattern for matching the pieces -- pat <- -- case resDisp of -- Methods Nothing _ -> return $ ListP $ map (maybe WildP VarP) xs -- _ -> do -- let cons = mkName ":" -- return $ foldr (\a b -> ConP cons [maybe WildP VarP a, b]) (VarP xrest) xs -- -- -- Convert the xs -- fromPathPiece' <- [|fromPathPiece|] -- xstmts <- forM ys $ \(x, y) -> return $ BindS (VarP y) (fromPathPiece' `AppE` VarE x) -- -- -- Convert the xrest if appropriate -- (reststmts, yrest') <- -- case resDisp of -- Methods (Just _) _ -> do -- fromPathMultiPiece' <- [|fromPathMultiPiece|] -- return ([BindS (VarP yrest) (fromPathMultiPiece' `AppE` VarE xrest)], [yrest]) -- _ -> return ([], []) -- -- -- The final expression that actually uses the values we've computed -- caller <- buildCaller runHandler dispatcher fixHandler xrest parents name resDisp $ map snd ys ++ yrest' -- -- -- Put together all the statements -- just <- [|Just|] -- let stmts = concat -- [ xstmts -- , reststmts -- , [NoBindS $ just `AppE` caller] -- ] -- -- errorMsg <- [|error "Invariant violated"|] -- let matches = -- [ Match pat (NormalB $ DoE stmts) [] -- , Match WildP (NormalB errorMsg) [] -- ] -- -- return $ LamE [VarP pieces] $ CaseE (VarE pieces) matches -- ---- | The final expression in the individual Route definitions. --buildCaller :: Q Exp -- ^ runHandler -- -> Q Exp -- ^ dispatcher -- -> Q Exp -- ^ fixHandler -- -> Name -- ^ xrest -- -> [(String, [(CheckOverlap, Piece a)])] -- -> String -- ^ name of resource -- -> Dispatch a -- -> [Name] -- ^ ys -- -> Q Exp --buildCaller runHandler dispatcher fixHandler xrest parents name resDisp ys = do -- master <- newName "master" -- sub <- newName "sub" -- toMaster <- newName "toMaster" -- app404 <- newName "_app404" -- handler405 <- newName "_handler405" -- method <- newName "_method" -- -- let pat = map VarP [master, sub, toMaster, app404, handler405, method] -- -- -- Create the route -- let route = routeFromDynamics parents name ys -- -- exp <- -- case resDisp of -- Methods _ ms -> do -- handler <- newName "handler" -- -- -- Run the whole thing -- runner <- [|$(runHandler) -- $(return $ VarE handler) -- $(return $ VarE master) -- $(return $ VarE sub) -- (Just $(return route)) -- $(return $ VarE toMaster)|] -- -- let myLet handlerExp = -- LetE [FunD handler [Clause [] (NormalB handlerExp) []]] runner -- -- if null ms -- then do -- -- Just a single handler -- fh <- fixHandler -- let he = fh `AppE` foldl' (\a b -> a `AppE` VarE b) (VarE $ mkName $ "handle" ++ name) ys -- return $ myLet he -- else do -- -- Individual methods -- mf <- [|Map.lookup $(return $ VarE method) $(return $ VarE $ methodMapName name)|] -- f <- newName "f" -- let apply = foldl' (\a b -> a `AppE` VarE b) (VarE f) ys -- let body405 = -- VarE handler405 -- `AppE` route -- return $ CaseE mf -- [ Match (ConP 'Just [VarP f]) (NormalB $ myLet apply) [] -- , Match (ConP 'Nothing []) (NormalB body405) [] -- ] -- -- Subsite _ getSub -> do -- let sub2 = foldl' (\a b -> a `AppE` VarE b) (VarE (mkName getSub) `AppE` VarE sub) ys -- [|$(dispatcher) -- $(return $ VarE master) -- $(return sub2) -- ($(return $ VarE toMaster) . $(return route)) -- $(return $ VarE app404) -- ($(return $ VarE handler405) . $(return route)) -- $(return $ VarE method) -- $(return $ VarE xrest) -- |] -- -- return $ LamE pat exp -- ---- | Convert a 'Piece' to a 'D.Piece' --convertPiece :: Piece a -> Q Exp --convertPiece (Static s) = [|D.Static (pack $(lift s))|] --convertPiece (Dynamic _) = [|D.Dynamic|] -- --routeFromDynamics :: [(String, [(CheckOverlap, Piece a)])] -- ^ parents -- -> String -- ^ constructor name -- -> [Name] -- -> Exp --routeFromDynamics [] name ys = foldl' (\a b -> a `AppE` VarE b) (ConE $ mkName name) ys --routeFromDynamics ((parent, pieces):rest) name ys = -- foldl' (\a b -> a `AppE` b) (ConE $ mkName parent) here -- where -- (here', ys') = splitAt (length $ filter (isDynamic . snd) pieces) ys -- isDynamic Dynamic{} = True -- isDynamic _ = False -- here = map VarE here' ++ [routeFromDynamics rest name ys'] -diff --git a/Yesod/Routes/TH/Types.hs b/Yesod/Routes/TH/Types.hs -index 52cd446..18208d3 100644 ---- a/Yesod/Routes/TH/Types.hs -+++ b/Yesod/Routes/TH/Types.hs -@@ -29,10 +29,6 @@ instance Functor ResourceTree where - fmap f (ResourceLeaf r) = ResourceLeaf (fmap f r) - fmap f (ResourceParent a b c) = ResourceParent a (map (second $ fmap f) b) $ map (fmap f) c - --instance Lift t => Lift (ResourceTree t) where -- lift (ResourceLeaf r) = [|ResourceLeaf $(lift r)|] -- lift (ResourceParent a b c) = [|ResourceParent $(lift a) $(lift b) $(lift c)|] -- - data Resource typ = Resource - { resourceName :: String - , resourcePieces :: [(CheckOverlap, Piece typ)] -@@ -45,9 +41,6 @@ type CheckOverlap = Bool - instance Functor Resource where - fmap f (Resource a b c) = Resource a (map (second $ fmap f) b) (fmap f c) - --instance Lift t => Lift (Resource t) where -- lift (Resource a b c) = [|Resource $(lift a) $(lift b) $(lift c)|] -- - data Piece typ = Static String | Dynamic typ - deriving Show - -@@ -55,10 +48,6 @@ instance Functor Piece where - fmap _ (Static s) = (Static s) - fmap f (Dynamic t) = Dynamic (f t) - --instance Lift t => Lift (Piece t) where -- lift (Static s) = [|Static $(lift s)|] -- lift (Dynamic t) = [|Dynamic $(lift t)|] -- - data Dispatch typ = - Methods - { methodsMulti :: Maybe typ -- ^ type of the multi piece at the end -@@ -74,11 +63,6 @@ instance Functor Dispatch where - fmap f (Methods a b) = Methods (fmap f a) b - fmap f (Subsite a b) = Subsite (f a) b - --instance Lift t => Lift (Dispatch t) where -- lift (Methods Nothing b) = [|Methods Nothing $(lift b)|] -- lift (Methods (Just t) b) = [|Methods (Just $(lift t)) $(lift b)|] -- lift (Subsite t b) = [|Subsite $(lift t) $(lift b)|] -- - resourceMulti :: Resource typ -> Maybe typ - resourceMulti Resource { resourceDispatch = Methods (Just t) _ } = Just t - resourceMulti _ = Nothing -diff --git a/yesod-routes.cabal b/yesod-routes.cabal -index eb367b3..dc6a12c 100644 ---- a/yesod-routes.cabal -+++ b/yesod-routes.cabal -@@ -23,31 +23,10 @@ library - , path-pieces >= 0.1 && < 0.2 - - exposed-modules: Yesod.Routes.Dispatch -- Yesod.Routes.TH - Yesod.Routes.Class -- Yesod.Routes.Parse -- Yesod.Routes.Overlap -- other-modules: Yesod.Routes.TH.Dispatch -- Yesod.Routes.TH.RenderRoute - Yesod.Routes.TH.Types - ghc-options: -Wall - --test-suite runtests -- type: exitcode-stdio-1.0 -- main-is: main.hs -- hs-source-dirs: test -- other-modules: Hierarchy -- -- build-depends: base >= 4.3 && < 5 -- , yesod-routes -- , text >= 0.5 && < 0.12 -- , HUnit >= 1.2 && < 1.3 -- , hspec >= 1.3 -- , containers -- , template-haskell -- , path-pieces -- ghc-options: -Wall -- - source-repository head - type: git - location: https://github.com/yesodweb/yesod --- -1.8.2.rc3 - |