route-generator 0.5 → 0.6

raw patch · 2 files changed

+43/−37 lines, 2 files

Files

• route-generator.cabal +1/−1
• routeGenerator.hs +42/−36

@@ -1,5 +1,5 @@ name:            route-generator-version:         0.5+version:         0.6 cabal-version:   >= 1.8 license:         OtherLicense license-file:    COPYING

@@ -7,7 +7,7 @@ import System.IO (hPutStrLn, stderr) import Data.List (intercalate) import Data.Char (isUpper, isSpace)-import Data.Maybe (catMaybes, isJust)+import Data.Maybe (catMaybes, isJust, fromMaybe) import Yesod.Routes.Dispatch (Piece(Static, Dynamic)) import Network.URI (escapeURIString, isReserved, isUnescapedInURI) @@ -18,7 +18,7 @@ import Data.Attoparsec.Text import Control.Applicative -data Flag = Help | PathHelpers | Routes | NArgs Int | Mod String deriving (Show, Read, Eq)+data Flag = Help | PathHelpers | Routes | NArgs Int | Mod String | OutputName String deriving (Show, Read, Eq)  flags :: [OptDescr Flag] flags = [@@ -26,6 +26,7 @@ 		Option ['p'] ["pathHelpers"] (NoArg PathHelpers) "Generate actionPath helper functions.", 		Option ['m'] ["module"] (ReqArg Mod "MODULE") "Implementation module to import.", 		Option ['n'] ["nArgs"] (ReqArg (NArgs . read) "NARGS") "Number of arguments the `route` function takes.",+		Option ['o'] ["outputName"] (ReqArg OutputName "NAME") "Name of the output module (defaults to Routes).", 		Option ['h'] ["help"] (NoArg Help) "Show this help text." 	] @@ -33,7 +34,7 @@ usage errors = do 	mapM_ (hPutStrLn stderr) errors 	name <- getProgName-	hPutStrLn stderr $ usageInfo (name ++ " -r -p [-m MODULE] [-n NARGS] <input-file>") flags+	hPutStrLn stderr $ usageInfo (name ++ " -r -p [-m MODULE] [-n NARGS] [-o NAME] <input-file>") flags  data Route = Route { 		method :: Text,@@ -169,43 +170,48 @@ 			hPutStrLn stderr "Must pass -r or -p" 			usage errors >> exitFailure 		_ -> main' (head args) flags-	where-	main' input flags = do-		Right routes <- fmap (parseOnly parser) $ T.readFile input -		when (Routes `elem` flags) $ do-			-- GHC pragma turns off warnings we know about-			-- Should be ignored by other compilers, so is safe-			putStrLn "{-# OPTIONS_GHC -fno-warn-missing-signatures #-}"-			putStrLn "module Routes where"-			putStrLn ""+main' :: FilePath -> [Flag] -> IO ()+main' input flags = do+	Right routes <- fmap (parseOnly parser) $ T.readFile input -		mapM_ (\flag -> case flag of-				Mod m -> putStrLn $ "import " ++ m-				_ -> return ()-			) flags+	when (Routes `elem` flags) $ do+		-- GHC pragma turns off warnings we know about+		-- Should be ignored by other compilers, so is safe+		putStrLn "{-# OPTIONS_GHC -fno-warn-missing-signatures #-}"+		putStrLn $ "module " ++ fromFlags "Routes" getOutputName ++ " where"+		putStrLn "" -		when (Routes `elem` flags) $ do-			putStrLn "import Control.Monad (ap)"-			putStrLn "import Data.Text (pack)"-			putStrLn "import Web.PathPieces (fromPathPiece, fromPathMultiPiece)"-			putStrLn "import Yesod.Routes.Dispatch (Route(..), Piece(Static, Dynamic))"+	mapM_ (\flag -> case flag of+			Mod m -> putStrLn $ "import " ++ m+			_ -> return ()+		) flags -		-- Fully qualified to help when using with CPP-		when (PathHelpers `elem` flags) $ do-			putStrLn "import qualified Data.List (intercalate)"-			putStrLn "import qualified Network.URI (URI(..), escapeURIString, isReserved, isUnescapedInURI)"-			putStrLn "import qualified Data.Text (unpack)"-			putStrLn "import qualified Web.PathPieces (toPathPiece, toPathMultiPiece)"-			putStrLn "import qualified Network.URI.Partial"+	when (Routes `elem` flags) $ do+		putStrLn "import Control.Monad (ap)"+		putStrLn "import Data.Text (pack)"+		putStrLn "import Web.PathPieces (fromPathPiece, fromPathMultiPiece)"+		putStrLn "import Yesod.Routes.Dispatch (Route(..), Piece(Static, Dynamic))" -		putStrLn ""+	-- Fully qualified to help when using with CPP+	when (PathHelpers `elem` flags) $ do+		putStrLn "import qualified Data.List (intercalate)"+		putStrLn "import qualified Network.URI (URI(..), escapeURIString, isReserved, isUnescapedInURI)"+		putStrLn "import qualified Data.Text (unpack)"+		putStrLn "import qualified Web.PathPieces (toPathPiece, toPathMultiPiece)"+		putStrLn "import qualified Network.URI.Partial" -		let nArgs = getNArgs flags-		when (PathHelpers `elem` flags) (emitPathHelpers routes nArgs)-		when (Routes `elem` flags)  (emitRoutes routes nArgs)+	putStrLn "" -	getNArgs = foldr (\flag n -> case (n,flag) of-			(0, NArgs n) -> n-			_ -> n-		) 0+	let nArgs = fromFlags 0 getNArg+	when (PathHelpers `elem` flags) (emitPathHelpers routes nArgs)+	when (Routes `elem` flags)  (emitRoutes routes nArgs)++	where+	fromFlags def sel = foldr (\f d -> fromMaybe d (sel f)) def flags++	getOutputName (OutputName n) = Just n+	getOutputName _ = Nothing++	getNArg (NArgs n) = Just n+	getNArg _ = Nothing