Skip to content
Browse files

Made Routes Module Name Configurable

It was hardcoded to spit out a module called "Routes", no matter where
you wanted to put it.
Since filenames and module names are linked, though, this got really
grouchy when you put it anywhere other than a file called Routes.hs

Better now.
  • Loading branch information...
1 parent d68f5cb commit eb44c14891fa12b3b5cf63f08999c7bd2751166f @psycotica0 psycotica0 committed with Sep 20, 2013
Showing with 8 additions and 3 deletions.
  1. +8 −3 routeGenerator.hs
View
11 routeGenerator.hs
@@ -18,22 +18,23 @@ import qualified Data.Text.IO as T
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 = [
Option ['r'] ["routes"] (NoArg Routes) "Generate routes.",
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."
]
usage :: [String] -> IO ()
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,
@@ -177,7 +178,7 @@ main = 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 $ "module " ++ getOutputName flags ++ " where"
putStrLn ""
mapM_ (\flag -> case flag of
@@ -205,6 +206,10 @@ main = do
when (PathHelpers `elem` flags) (emitPathHelpers routes nArgs)
when (Routes `elem` flags) (emitRoutes routes nArgs)
+ getOutputName = foldr (\flag n -> case flag of
+ OutputName n' -> n'
+ _ -> n
+ ) "Routes"
getNArgs = foldr (\flag n -> case (n,flag) of
(0, NArgs n) -> n
_ -> n

0 comments on commit eb44c14

Please sign in to comment.
Something went wrong with that request. Please try again.