From 438678e083da06be531aea75eb619adf28d550c3 Mon Sep 17 00:00:00 2001
From: Anupam Jain <ajnsit@gmail.com>
Date: Thu, 9 Feb 2017 10:47:25 +0530
Subject: [PATCH] Sync Routing code with yesod

---
 src/Routes/Parse.hs          |  2 +-
 src/Routes/TH/RenderRoute.hs | 14 +++++++++-----
 src/Routes/TH/RouteAttrs.hs  |  9 ++++++---
 src/Routes/TH/Types.hs       |  4 ++--
 4 files changed, 18 insertions(+), 11 deletions(-)

diff --git a/src/Routes/Parse.hs b/src/Routes/Parse.hs
index e6d1b7a..c999ac7 100644
--- a/src/Routes/Parse.hs
+++ b/src/Routes/Parse.hs
@@ -63,7 +63,7 @@ parseRoutesNoCheck = QuasiQuoter
 -- invalid input.
 resourcesFromString :: String -> [ResourceTree String]
 resourcesFromString =
-    fst . parse 0 . filter (not . all (== ' ')) . lines
+    fst . parse 0 . filter (not . all (== ' ')) . lines . filter (/= '\r')
   where
     parse _ [] = ([], [])
     parse indent (thisLine:otherLines)
diff --git a/src/Routes/TH/RenderRoute.hs b/src/Routes/TH/RenderRoute.hs
index 88e9e4a..3f28cf7 100644
--- a/src/Routes/TH/RenderRoute.hs
+++ b/src/Routes/TH/RenderRoute.hs
@@ -46,7 +46,9 @@ mkRouteCons rttypes =
 
     mkRouteCon (ResourceParent name _check pieces children) = do
         (cons, decs) <- mkRouteCons children
-#if MIN_VERSION_template_haskell(2,11,0)
+#if MIN_VERSION_template_haskell(2,12,0)
+        dec <- DataD [] (mkName name) [] Nothing cons <$> fmap (pure . DerivClause Nothing) (mapM conT [''Show, ''Read, ''Eq])
+#elif MIN_VERSION_template_haskell(2,11,0)
         dec <- DataD [] (mkName name) [] Nothing cons <$> mapM conT [''Show, ''Read, ''Eq]
 #else
         let dec = DataD [] (mkName name) [] cons [''Show, ''Read, ''Eq]
@@ -55,7 +57,7 @@ mkRouteCons rttypes =
       where
         con = NormalC (mkName name)
             $ map (\x -> (notStrict, x))
-            $ concat [singles, [ConT $ mkName name]]
+            $ singles ++ [ConT $ mkName name]
 
         singles = concatMap toSingle pieces
         toSingle Static{} = []
@@ -99,7 +101,7 @@ mkRenderRouteClauses =
         dyns <- replicateM cnt $ newName "dyn"
         sub <-
             case resourceDispatch res of
-                Subsite{} -> fmap return $ newName "sub"
+                Subsite{} -> return <$> newName "sub"
                 _ -> return []
         let pat = ConP (mkName $ resourceName res) $ map VarP $ dyns ++ sub
 
@@ -136,7 +138,7 @@ mkRenderRouteClauses =
     mkPieces _ _ [] _ = []
     mkPieces toText tsp (Static s:ps) dyns = toText s : mkPieces toText tsp ps dyns
     mkPieces toText tsp (Dynamic{}:ps) (d:dyns) = tsp `AppE` VarE d : mkPieces toText tsp ps dyns
-    mkPieces _ _ ((Dynamic _) : _) [] = error "mkPieces 120"
+    mkPieces _ _ (Dynamic _ : _) [] = error "mkPieces 120"
 
 -- | Generate the 'RenderRoute' instance.
 --
@@ -153,7 +155,9 @@ mkRenderRouteInstance' :: Cxt -> Type -> [ResourceTree Type] -> Q [Dec]
 mkRenderRouteInstance' cxt typ ress = do
     cls <- mkRenderRouteClauses ress
     (cons, decs) <- mkRouteCons ress
-#if MIN_VERSION_template_haskell(2,11,0)
+#if MIN_VERSION_template_haskell(2,12,0)
+    did <- DataInstD [] ''Route [typ] Nothing cons <$> fmap (pure . DerivClause Nothing) (mapM conT clazzes)
+#elif MIN_VERSION_template_haskell(2,11,0)
     did <- DataInstD [] ''Route [typ] Nothing cons <$> mapM conT clazzes
 #else
     let did = DataInstD [] ''Route [typ] cons clazzes
diff --git a/src/Routes/TH/RouteAttrs.hs b/src/Routes/TH/RouteAttrs.hs
index d644a54..b81cc3f 100644
--- a/src/Routes/TH/RouteAttrs.hs
+++ b/src/Routes/TH/RouteAttrs.hs
@@ -9,6 +9,9 @@ import Routes.Class
 import Language.Haskell.TH.Syntax
 import Data.Set (fromList)
 import Data.Text (pack)
+#if __GLASGOW_HASKELL__ < 710
+import Control.Applicative ((<$>))
+#endif
 
 mkRouteAttrsInstance :: Type -> [ResourceTree a] -> Q Dec
 mkRouteAttrsInstance typ ress = do
@@ -18,11 +21,11 @@ mkRouteAttrsInstance typ ress = do
         ]
 
 goTree :: (Pat -> Pat) -> ResourceTree a -> Q [Clause]
-goTree front (ResourceLeaf res) = fmap return $ goRes front res
+goTree front (ResourceLeaf res) = return <$> goRes front res
 goTree front (ResourceParent name _check pieces trees) =
-    fmap concat $ mapM (goTree front') trees
+    concat <$> mapM (goTree front') trees
   where
-    ignored = ((replicate toIgnore WildP ++) . return)
+    ignored = (replicate toIgnore WildP ++) . return
     toIgnore = length $ filter isDynamic pieces
     isDynamic Dynamic{} = True
     isDynamic Static{} = False
diff --git a/src/Routes/TH/Types.hs b/src/Routes/TH/Types.hs
index 6536960..2436c41 100644
--- a/src/Routes/TH/Types.hs
+++ b/src/Routes/TH/Types.hs
@@ -53,11 +53,11 @@ data Piece typ = Static String | Dynamic typ
     deriving Show
 
 instance Functor Piece where
-    fmap _ (Static s) = (Static s)
+    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 (Static s)  = [|Static  $(lift s)|]
     lift (Dynamic t) = [|Dynamic $(lift t)|]
 
 data Dispatch typ =