web-routes-quasi 0.6.1.3 → 0.6.2

raw patch · 3 files changed

+35/−35 lines, 3 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• Web/Routes/Quasi/Parse.hs +0/−5
• Web/Routes/Quasi/TH.hs +34/−29
• web-routes-quasi.cabal +1/−1

@@ -11,7 +11,6 @@ import Language.Haskell.TH.Syntax import Language.Haskell.TH.Quote import Data.Data-import Data.Char import Data.Maybe  -- | A quasi-quoter to parse a string into a list of 'Resource's. Checks for@@ -93,10 +92,6 @@                  in Just $ Resource constr pieces rest             [] -> Nothing             _ -> error $ "Invalid resource line: " ++ s---- | Drop leading whitespace.-trim :: String -> String-trim = dropWhile isSpace  drop1Slash :: String -> String drop1Slash ('/':x) = x

@@ -23,7 +23,7 @@         , ssRender :: Exp         , ssDispatch :: Exp         , ssToMasterArg :: Exp-        , ssPieces :: [String]+        , ssPieces :: [Piece]         }   | Simple [Piece] [String] -- ^ methods type THResource = (String, Pieces)@@ -32,8 +32,8 @@ createRoutes res =     return $ map go res   where-    go (n, SubSite{ssType = s}) =-        NormalC (mkName n) [(NotStrict, s)]+    go (n, SubSite{ssType = s, ssPieces = pieces}) =+        NormalC (mkName n) $ mapMaybe go' pieces ++ [(NotStrict, s)]     go (n, Simple pieces _) = NormalC (mkName n) $ mapMaybe go' pieces     go' (SinglePiece x) = Just (NotStrict, ConT $ mkName x)     go' (MultiPiece x) = Just (NotStrict, ConT $ mkName x)@@ -48,45 +48,46 @@                 then clauses                 else clauses ++ [final']   where-    go (constr, SubSite{ssParse = p, ssPieces = pieces}) = do-        let cons = ConP $ mkName ":"+    cons x y = ConP (mkName ":") [x, y]+    go (constr, SubSite{ssParse = p, ssPieces = ps}) = do+        ri <- [|Right|]+        be <- [|ape|]+        (pat', parse) <- mkPat' be ps $ ri `AppE` ConE (mkName constr)+                 x <- newName "x"-        let pat = foldr (\a b -> cons [LitP (StringL a), b]) (VarP x) pieces+        let pat = init pat' ++ [VarP x]++        --let pat = foldr (\a b -> cons [LitP (StringL a), b]) (VarP x) pieces         let eitherSub = p `AppE` VarE x-        fmape' <- [|fmape|]-        let bod = fmape' `AppE` ConE (mkName constr) `AppE` eitherSub-        return $ Clause [pat] (NormalB bod) []+        let bod = be `AppE` parse `AppE` eitherSub+        --let bod = fmape' `AppE` ConE (mkName constr) `AppE` eitherSub+        return $ Clause [foldr1 cons pat] (NormalB bod) []     go (n, Simple ps _) = do         ri <- [|Right|]         be <- [|ape|]         (pat, parse) <- mkPat' be ps $ ri `AppE` ConE (mkName n)-        return $ Clause [pat] (NormalB parse) []+        return $ Clause [foldr1 cons pat] (NormalB parse) []     final = do         no <- [|Left "Invalid URL"|]         return $ Clause [WildP] (NormalB no) []-    mkPat' :: Exp -> [Piece] -> Exp -> Q (Pat, Exp)+    mkPat' :: Exp -> [Piece] -> Exp -> Q ([Pat], Exp)     mkPat' be [MultiPiece s] parse = do         v <- newName $ "var" ++ s         fmp <- [|fromMultiPiece|]         let parse' = InfixE (Just parse) be $ Just $ fmp `AppE` VarE v-        return (VarP v, parse')+        return ([VarP v], parse')     mkPat' _ (MultiPiece _:_) _parse = error "MultiPiece must be last"     mkPat' be (StaticPiece s:rest) parse = do         (x, parse') <- mkPat' be rest parse-        let cons = ConP $ mkName ":"-        return $ (cons [LitP $ StringL s, x], parse')+        let sp = LitP $ StringL s+        return (sp : x, parse')     mkPat' be (SinglePiece s:rest) parse = do         fsp <- [|fromSinglePiece|]         v <- newName $ "var" ++ s         let parse' = InfixE (Just parse) be $ Just $ fsp `AppE` VarE v         (x, parse'') <- mkPat' be rest parse'-        let cons = ConP $ mkName ":"-        return (cons [VarP v, x], parse'')-    mkPat' _ [] parse = return (ListP [], parse)--fmape :: (a -> b) -> Either String a -> Either String b-fmape _ (Left s) = Left s-fmape f (Right a) = Right $ f a+        return (VarP v : x, parse'')+    mkPat' _ [] parse = return ([ListP []], parse)  -- | 'ap' for 'Either' ape :: Either String (a -> b) -> Either String a -> Either String b@@ -105,13 +106,14 @@         bod <- mkBod ps'         return $ Clause [pat] (NormalB $ TupE [bod, ListE []]) []     go (n, SubSite{ssRender = r, ssPieces = pieces}) = do-        cons' <- [|\a (b, c) -> (a : b, c)|]+        cons' <- [|\a (b, c) -> (a ++ b, c)|]         let cons a b = cons' `AppE` a `AppE` b         x <- newName "x"         let r' = r `AppE` VarE x-        let pat = ConP (mkName n) [VarP x]-        let bod = foldr (\a b -> cons (LitE $ StringL a) b) r' pieces-        return $ Clause [pat] (NormalB bod) []+        let pieces' = zip [1..] pieces+        let pat = ConP (mkName n) $ mapMaybe go' pieces' ++ [VarP x]+        bod <- mkBod pieces'+        return $ Clause [pat] (NormalB $ cons bod r') []     go' (_, StaticPiece _) = Nothing     go' (i, _) = Just $ VarP $ mkName $ "var" ++ show (i :: Int)     mkBod [] = lift ([] :: [String])@@ -146,7 +148,7 @@             (MultiPiece _:rest) -> go' Left rest             x -> go' Right x     go (n, SubSite{ssPieces = ps}) =-        go (n, Simple (map StaticPiece ps ++ [MultiPiece ""]) [])+        go (n, Simple (ps ++ [MultiPiece ""]) [])     go' b x = if all isSingle x then Just (b $ length x) else Nothing     helper 0 _ = True     helper _ [] = False@@ -175,13 +177,16 @@                   ]         bod <- go' n meth xs methods         return $ Clause pat (NormalB bod) []-    go (n, SubSite{ssDispatch = d, ssToMasterArg = tma}) = do+    go (n, SubSite{ssDispatch = d, ssToMasterArg = tma, ssPieces = ps}) = do         meth <- newName "method"         x <- newName "x"-        let pat = [ConP (mkName n) [VarP x], VarP meth]+        xs <- mapM newName $ replicate (length $ filter notStatic ps) "x"+        let pat = [ConP (mkName n) $ map VarP xs ++ [VarP x], VarP meth]         let bod = d `AppE` VarE x `AppE` VarE meth         fmap' <- [|fmap|]-        let toMaster' = toMaster `AppE` ConE (mkName n) `AppE` tma `AppE` VarE x+        let routeToMaster = foldl AppE (ConE (mkName n)) $ map VarE xs+            tma' = foldl AppE tma $ map VarE xs+        let toMaster' = toMaster `AppE` routeToMaster `AppE` tma' `AppE` VarE x         let bod' = InfixE (Just toMaster') fmap' (Just bod)         let bod'' = InfixE (Just modMaster) fmap' (Just bod')         return $ Clause pat (NormalB bod'') []

@@ -1,5 +1,5 @@ name:            web-routes-quasi-version:         0.6.1.3+version:         0.6.2 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>