Skip to content
Browse files

Clean up flag selector code

  • Loading branch information...
1 parent eb44c14 commit 7d68ec0099744537a7fb430652c9b90743e96c82 @singpolyma committed
Showing with 43 additions and 42 deletions.
  1. +43 −42 routeGenerator.hs
View
85 routeGenerator.hs
@@ -7,7 +7,7 @@ import System.Console.GetOpt (getOpt, usageInfo, ArgOrder(..), OptDescr(..), Arg
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)
@@ -170,47 +170,48 @@ main = do
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 " ++ getOutputName flags ++ " where"
- putStrLn ""
-
- mapM_ (\flag -> case flag of
- Mod m -> putStrLn $ "import " ++ m
- _ -> return ()
- ) flags
-
- 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))"
-
- -- 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"
+main' :: FilePath -> [Flag] -> IO ()
+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 " ++ fromFlags "Routes" getOutputName ++ " where"
putStrLn ""
- let nArgs = getNArgs flags
- 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
+ mapM_ (\flag -> case flag of
+ Mod m -> putStrLn $ "import " ++ m
+ _ -> return ()
+ ) flags
+
+ 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))"
+
+ -- 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"
+
+ putStrLn ""
+
+ 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

0 comments on commit 7d68ec0

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