Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
It's moved into `src` directory.
  • Loading branch information
Ephemera committed Jul 29, 2017
1 parent e027652 commit b9c2498
Showing 1 changed file with 19 additions and 6 deletions.
25 changes: 19 additions & 6 deletions yesod-bin/AddHandler.hs
Expand Up @@ -8,6 +8,10 @@ import Data.List (isPrefixOf, isSuffixOf, stripPrefix)
import Data.Maybe (fromMaybe)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Distribution.PackageDescription.Parse (readPackageDescription)
import Distribution.PackageDescription.Configuration (flattenPackageDescription)
import Distribution.PackageDescription (allBuildInfo, hsSourceDirs)
import Distribution.Verbosity (normal)
import System.Directory (getDirectoryContents, doesFileExist)
import Control.Monad (unless)

Expand All @@ -31,7 +35,7 @@ cmdLineArgsError = "You have to specify a route name if you want to add handler
addHandler :: Maybe String -> Maybe String -> [String] -> IO ()
addHandler (Just route) pat met = do
cabal <- getCabal
checked <- checkRoute route
checked <- checkRoute route cabal
let routePair = case checked of
Left err@EmptyRoute -> (error . show) err
Left err@RouteCaseError -> (error . show) err
Expand All @@ -54,7 +58,7 @@ addHandlerInteractive = do
putStr "Name of route (without trailing R): "
hFlush stdout
name <- getLine
checked <- checkRoute name
checked <- checkRoute name cabal
case checked of
Left err@EmptyRoute -> (error . show) err
Left err@RouteCaseError -> print err >> routeInput
Expand All @@ -75,7 +79,9 @@ addHandlerInteractive = do

addHandlerFiles :: FilePath -> (String, FilePath) -> String -> String -> IO ()
addHandlerFiles cabal (name, handlerFile) pattern methods = do
modify "Application.hs" $ fixApp name
src <- getSrcDir cabal
let applicationFile = concat [src, "/Application.hs"]
modify applicationFile $ fixApp name
modify cabal $ fixCabal name
modify "config/routes" $ fixRoutes name pattern methods
writeFile handlerFile $ mkHandler name pattern methods
Expand All @@ -94,15 +100,16 @@ getCabal = do
[] -> error "No cabal file found"
_ -> error "Too many cabal files found"

checkRoute :: String -> IO (Either RouteError (String, FilePath))
checkRoute name =
checkRoute :: String -> FilePath -> IO (Either RouteError (String, FilePath))
checkRoute name cabal =
case name of
[] -> return $ Left EmptyRoute
c:_
| isLower c -> return $ Left RouteCaseError
| otherwise -> do
-- Check that the handler file doesn't already exist
let handlerFile = concat ["Handler/", name, ".hs"]
src <- getSrcDir cabal
let handlerFile = concat [src, "/Handler/", name, ".hs"]
exists <- doesFileExist handlerFile
if exists
then (return . Left . RouteExists) handlerFile
Expand Down Expand Up @@ -214,3 +221,9 @@ mkHandler name pattern methods = unlines
uncapitalize :: String -> String
uncapitalize (x:xs) = toLower x : xs
uncapitalize "" = ""

getSrcDir :: FilePath -> IO FilePath
getSrcDir cabal = do
pd <- readPackageDescription normal cabal
let dirs = concatMap hsSourceDirs . allBuildInfo $ flattenPackageDescription pd
return (dirs !! 0)

0 comments on commit b9c2498

Please sign in to comment.