hi 0.0.8.2 → 1.0.0.0

raw patch · 15 files changed

+381/−367 lines, 15 filesdep +ansi-wl-pprintdep +optparse-applicativedep +silentlydep −temporary-rcdep ~hspecPVP ok

version bump matches the API change (PVP)

Dependencies added: ansi-wl-pprint, optparse-applicative, silently, temporary

Dependencies removed: temporary-rc

Dependency ranges changed: hspec

API changes (from Hackage documentation)

Files

• hi.cabal +102/−106
• src/Hi.hs +35/−19
• src/Hi/Cli.hs +48/−0
• src/Hi/CommandLineOption.hs +30/−0
• src/Hi/Config.hs +7/−7
• src/Hi/Directory.hs +2/−2
• src/Hi/FilePath.hs +33/−14
• src/Hi/Git.hs +23/−11
• src/Hi/Option.hs +70/−165
• src/Hi/Template.hs +3/−4
• src/Hi/Types.hs +15/−14
• src/Hi/Utils.hs +0/−6
• src/Hi/Version.hs +0/−7
• src/Main.hs +6/−11
• test/doctests.hs +7/−1

@@ -1,29 +1,24 @@-name:                hi-version:             0.0.8.2-synopsis:            Generate scaffold for cabal project-license:             BSD3-license-file:        LICENSE-author:              Fujimura Daisuke-maintainer:          me@fujimuradaisuke.com-category:            Distribution-build-type:          Simple-cabal-version:       >=1.8-homepage:            https://github.com/fujimura/hi+name: hi+version: 1.0.0.0+cabal-version: >=1.8+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: me@fujimuradaisuke.com+homepage: https://github.com/fujimura/hi+bug-reports: https://github.com/fujimura/hi/issues+synopsis: Generate scaffold for cabal project description:     This application generates a scaffold for Haskell project from a Git repository.-     .     This command     .-     .-    > $ hi --package-name "foo-bar-baz" --module-name "Foo.Bar.Baz" --author "Fujimura Daisuke" --email "me@fujimuradaisuke.com"+    > $ hi foo-bar-baz     .-     .     will generate:     .-     .     > $ tree .     > .@@ -43,100 +38,101 @@     >     │      └── BazSpec.hs     >     └── Spec.hs     .-     .     See <https://github.com/fujimura/hi> for further usage.     .--+category: Distribution+author: Fujimura Daisuke+ +source-repository head+    type: git+    location: https://github.com/fujimura/hi.git+  library-  exposed-modules:-      Hi-      Hi.Config-      Hi.Directory-      Hi.FilePath-      Hi.Git-      Hi.Option-      Hi.Template-      Hi.Types-      Hi.Utils-      Hi.Version-  ghc-options:-      -Wall-  hs-source-dirs:-      src-  build-depends:-        base          == 4.*-      , bytestring-      , directory-      , filepath-      , parsec-      , process-      , split-      , template      == 0.2.*-      , temporary-rc  >= 1.2.0.3-      , text          > 1.0-      , time-+    build-depends:+        base ==4.*,+        ansi-wl-pprint -any,+        bytestring -any,+        directory -any,+        filepath -any,+        optparse-applicative >=0.10.0,+        parsec -any,+        process -any,+        split -any,+        template ==0.2.*,+        temporary >=1.2.0.3,+        text >1.0,+        time -any+    exposed-modules:+        Hi+        Hi.Cli+        Hi.Config+        Hi.Directory+        Hi.FilePath+        Hi.Git+        Hi.Option+        Hi.CommandLineOption+        Hi.Template+        Hi.Types+    exposed: True+    buildable: True+    hs-source-dirs: src+    other-modules:+        Paths_hi+    ghc-options: -Wall+  executable hi-  main-is:-      Main.hs-  ghc-options:-      -Wall-  hs-source-dirs:-      src-  build-depends:-        base       == 4.*-      , bytestring-      , directory-      , filepath-      , parsec-      , process-      , split-      , template   == 0.2.*-      , temporary-rc  == 1.2.0.3-      , text       > 1.0-      , time-+    build-depends:+        base ==4.*,+        ansi-wl-pprint -any,+        bytestring -any,+        directory -any,+        filepath -any,+        optparse-applicative >=0.10.0,+        parsec -any,+        process -any,+        split -any,+        template ==0.2.*,+        temporary ==1.2.0.3,+        text >1.0,+        time -any+    main-is: Main.hs+    buildable: True+    hs-source-dirs: src+    ghc-options: -Wall+  test-suite spec-  main-is:-      Spec.hs-  type:-      exitcode-stdio-1.0-  ghc-options:-      -Wall-  hs-source-dirs:-      src-    , test-  build-depends:-        base-      , HUnit-      , bytestring-      , directory-      , doctest-      , filepath-      , hspec       >= 1.7.2-      , parsec-      , process-      , split-      , template    == 0.2.*-      , temporary-rc   == 1.2.0.3-      , text       > 1.0-      , time-+    build-depends:+        base -any,+        ansi-wl-pprint -any,+        HUnit -any,+        bytestring -any,+        directory -any,+        doctest -any,+        filepath -any,+        hspec >=2.0.0,+        optparse-applicative >=0.10.0,+        parsec -any,+        process -any,+        silently -any,+        split -any,+        template ==0.2.*,+        temporary ==1.2.0.3,+        text >1.0,+        time -any+    type: exitcode-stdio-1.0+    main-is: Spec.hs+    buildable: True+    hs-source-dirs: src test+    ghc-options: -Wall test-suite doctests-  type:-      exitcode-stdio-1.0-  ghc-options:-      -threaded-  hs-source-dirs:-      src-    , test-  main-is:-      doctests.hs-  build-depends:-      base, doctest >= 0.8, process--source-repository head-  type:     git-  location: https://github.com/fujimura/hi.git+    build-depends:+        base -any,+        doctest >=0.8,+        process -any+    type: exitcode-stdio-1.0+    main-is: doctests.hs+    buildable: True+    hs-source-dirs: src test+    ghc-options: -threaded+ 

@@ -1,3 +1,4 @@+{-# LANGUAGE NamedFieldPuns, RecordWildCards #-} module Hi   (     run@@ -9,7 +10,6 @@ import qualified Hi.Git                   as Git import           Hi.Template              (readTemplates) import           Hi.Types-import           Hi.Utils  import           Control.Applicative import           Control.Monad@@ -21,17 +21,17 @@ import           Data.Text.Lazy.Encoding  (encodeUtf8) import           Data.Text.Template       (Context, substitute) import           System.Directory         (createDirectoryIfMissing)-import           System.FilePath          (dropFileName)+import           System.FilePath          (dropFileName, joinPath, splitPath, normalise) import           System.Process           (system)  -- | Run 'hi'.-run :: [Option] -> IO ()-run options = do-    putStrLn $ "Creating new project from repository: " ++ Git.expandUrl repository-    writeFiles =<< showFileList =<< process options <$> readTemplates repository-    postProcess options+run :: Option -> IO ()+run option@(Option {templateSource}) = do+    putStrLn $ "Creating new project with " ++ sourceName templateSource+    writeFiles =<< showFileList =<< process option . dropExtraRegularFiles <$> readTemplates templateSource+    postProcess option   where-    repository = fromJust $ lookupArg "repository" options+    sourceName (FromRepo repository) = "git repository:" ++ Git.expandUrl repository  -- |Write given 'Files' to filesystem. writeFiles :: Files -> IO ()@@ -46,7 +46,7 @@ -- | Show 'Files' to stdout. showFileList :: Files -> IO Files showFileList files = do-    mapM_ (showFile . getFilePath) files+    mapM_ (showFile . normalise. getFilePath) files     return files   where     showFile :: FilePath -> IO ()@@ -59,23 +59,39 @@ -- 1. rewrite path -- -- 2. substitute arguments-process :: [Option] -> Files -> Files-process options = map go+process :: Option -> Files -> Files+process Option {..} = map go   where     go (TemplateFile path content) = TemplateFile (rewritePath' path) (substitute' content)     go (RegularFile  path content) = RegularFile  (rewritePath' path) content-    rewritePath'     = rewritePath options+    rewritePath' path = joinPath $ packageName : splitPath (rewritePath packageName moduleName path)     substitute' text = BS.concat . LBS.toChunks . encodeUtf8 $                         substitute (decodeUtf8 text) (context options)+    options          = [("packageName", packageName)+                       ,("moduleName", moduleName)+                       ,("author", author)+                       ,("email", email)+                       ,("year", year)+                       ]  -- | Return 'Context' obtained by given 'Options'-context :: [Option] -> Context-context options x = T.pack (fromJust $ lookup (T.unpack x) [(k,v) | (Arg k v) <- options])+context :: [(String, String)] -> Context+context opts x = T.pack . fromJust $ lookup (T.unpack x) opts -postProcess :: [Option] -> IO ()-postProcess options = do-    when (InitializeGitRepository `elem` options) $-      -- TODO This wont' work unless template has `package-name` as root dir.-      inDirectory (fromJust $ lookupArg "packageName" options) $+postProcess :: Option -> IO ()+postProcess Option {initializeGitRepository, packageName} = do+    when initializeGitRepository $+      inDirectory packageName $         void $ system "git init && git add . && git commit -m \"Initial commit\""     return ()++-- | Drop 'RegularFile's if there is a 'TemplateFile' which has same name+dropExtraRegularFiles :: Files -> Files+dropExtraRegularFiles []     = []+dropExtraRegularFiles xs = go (map getFilePath xs) xs+  where+    go _ []       = []+    go paths (y@(RegularFile p _):ys)  = if p `elem` paths+                                           then go paths ys+                                           else y : go paths ys+    go paths (y@(TemplateFile _ _):ys) = y : go paths ys

@@ -0,0 +1,48 @@+module Hi.Cli+  ( run+  ) where++import qualified Hi+import           Hi.CommandLineOption         (CommandLineOption,+                                               commandLineOption, defaultRepo)+import           Hi.Option                    (buildOption)+import           Hi.Types++import           Data.Monoid                  (mempty)+import           Data.Version                 (showVersion)+import           Options.Applicative+import qualified Text.PrettyPrint.ANSI.Leijen as PP++import qualified Paths_hi                     (version)++run :: [String] -> IO ()+run []   = showHelpText (prefs idm) opts+run args = parseArgs args >>= Hi.run++parseArgs :: [String] -> IO Option+parseArgs args = handleParseResult (execParserPure (prefs idm) opts args) >>= buildOption++opts :: ParserInfo CommandLineOption+opts = info (helper <*> (version <*> commandLineOption))+  ( fullDesc+ <> header "Generate a haskell project based on a template from github."+ <> footerDoc (Just (PP.text footerText)))++footerText :: String+footerText = unlines [ ""+                     , "If repository is not provided, it defaults to the repository at"+                     , defaultRepo ++ "."+                     , ""+                     , "Example:"+                     , "    hi foo-bar"+                     ]++version :: Parser (a -> a)+version = infoOption (showVersion Paths_hi.version)+  (  short 'v'+  <> long "version"+  <> help "Print version information" )++showHelpText :: ParserPrefs -> ParserInfo a -> IO ()+showHelpText pprefs pinfo = handleParseResult . Failure $+  parserFailure pprefs pinfo ShowHelpText mempty

@@ -0,0 +1,30 @@+module Hi.CommandLineOption+  ( CommandLineOption(..)+  , commandLineOption+  , defaultRepo+  ) where++import           Options.Applicative++data CommandLineOption = CommandLineOption+                       { packageName             :: String+                       , moduleName              :: Maybe String+                       , author                  :: Maybe String+                       , email                   :: Maybe String+                       , repository              :: String+                       , configFilePath          :: Maybe String+                       , initializeGitRepository :: Maybe Bool+                       } deriving (Eq, Ord, Show)++commandLineOption :: Parser CommandLineOption+commandLineOption = CommandLineOption+   <$>          (strOption (short 'p' <> long "package-name" <> help "Name of package") <|> argument str (help "Name of package"))+   <*> optional (strOption (short 'm' <> long "moduleName"   <> help "Name of Module"))+   <*> optional (strOption (short 'a' <> long "author"       <> help "Name of the project's author"))+   <*> optional (strOption (short 'e' <> long "email"        <> help "Email address of the maintainer"))+   <*>           strOption (short 'r' <> long "repository"   <> help "Template repository" <> value defaultRepo)+   <*> optional (strOption (long "configuration-file"        <> help "Use specified configuration file"))+   <*> optional (switch    (long "initialize-git-repository" <> help "Initialize with git repository"))++defaultRepo :: String+defaultRepo = "git://github.com/fujimura/hi-hspec.git"

@@ -4,15 +4,15 @@       parseConfig     ) where -import           Control.Applicative   ((<$>), (<*))-import           Data.Maybe            (catMaybes)-import           Hi.Types+import           Control.Applicative ((<$>), (<*))+import           Control.Monad+import           Data.Maybe          (catMaybes) import           Text.Parsec import           Text.Parsec.String --- | Parse config file and return 'Option's.+-- | Parse config file parseConfig :: String -> [(String, String)]-parseConfig x = case parse configFile "ERROR" x of -- TODO Error message+parseConfig x = case parse configFile "Invalid config file format" x of       Left  l  -> error $ show l       Right xs -> xs @@ -23,7 +23,7 @@ sep = char ':'  name :: Parser String-name = many (oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ ['-'])+name = many (oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ "-")  eol :: Parser Char eol = newline <|> (eof >> return '\n')@@ -36,7 +36,7 @@ line :: Parser (Maybe (String, String)) line = do     spaces-    try (comment >> return Nothing) <|> (line' >>= return . Just)+    try (comment >> return Nothing) <|> liftM Just line'   where     line' = do         spaces

@@ -10,14 +10,14 @@  -- |Run callback in a temporary directory. inTemporaryDirectory :: String         -- ^ Base of temporary directory name-                     -> (IO a -> IO a) -- ^ Callback+                     -> IO a -> IO a -- ^ Callback inTemporaryDirectory name callback =     withSystemTempDirectory name $ flip inDirectory callback   -- |Run callback in given directory. inDirectory :: FilePath        -- ^ Filepath to run callback-            -> (IO a -> IO a)  -- ^ Callback+            -> IO a -> IO a  -- ^ Callback inDirectory path callback = do     pwd <- getCurrentDirectory     bracket_ (setCurrentDirectory path) (setCurrentDirectory pwd) callback

@@ -4,28 +4,47 @@     ) where  import           Hi.Template     (untemplate)-import           Hi.Types-import           Hi.Utils  import           Data.List import           Data.List.Split (splitOn)-import           Data.Maybe      (fromJust)-import           System.FilePath (joinPath)+import           System.FilePath (joinPath, splitPath)  -- | Convert given path to the destination path, with given options.-rewritePath :: [Option] -> FilePath -> FilePath-rewritePath options =-    rename1 . rename2 . untemplate+rewritePath :: String -> String -> FilePath -> FilePath+rewritePath packageName moduleName =+    replacePackageName . removeFirstPackageName . replaceModuleName . untemplate   where-    rename1 = replace "package-name" $ fromJust $ lookupArg "packageName" options-    rename2 = replace "ModuleName" $ toDir . fromJust $ lookupArg "moduleName" options+    replacePackageName = replace "package-name" packageName+    replaceModuleName  = replace "ModuleName" $ moduleNameToFilePath moduleName ++-- | Remove first occurence of given subdirectory+--+-- >>> removeFirstPackageName "package-name/bar.hs"+-- "bar.hs"+--+-- >>> removeFirstPackageName "package-name/package-name.hs"+-- "package-name.hs"+--+-- >>> removeFirstPackageName "package-name.hs"+-- "package-name.hs"+--+removeFirstPackageName :: FilePath -> FilePath+removeFirstPackageName path = go $ splitPath path+  where+    go :: [FilePath] -> FilePath+    go [] = []+    go (x:xs)+      | x == "package-name/" = joinPath xs+      | otherwise            = joinPath $ x:xs+ -- | Convert module name to path--- @--- toDir "Foo.bar" # => "Foo/Bar"--- @-toDir :: String -> FilePath-toDir = joinPath . splitOn "."+--+-- >>> moduleNameToFilePath "Foo.Bar"+-- "Foo/Bar"+--+moduleNameToFilePath :: String -> FilePath+moduleNameToFilePath = joinPath . splitOn "."  replace :: Eq a => [a] -> [a] -> [a] -> [a] replace a b = foldl1 (++) . intersperse b . splitOn a

@@ -1,27 +1,39 @@+{-# LANGUAGE ScopedTypeVariables #-}+ module Hi.Git     (       clone+    , config     , lsFiles     , expandUrl     ) where  import           Control.Applicative-import           Data.List           (isPrefixOf)-import           System.Exit         (ExitCode)-import           System.Process      (readProcess, system)+import           System.Exit+import           System.Process      (readProcess, readProcessWithExitCode, callCommand)+import           Control.Exception  expandUrl :: String -> String-expandUrl url = if "gh:" `isPrefixOf` url-                  then expand url-                  else url-  where expand (_:_:_:xs) = "git@github.com:" ++ xs ++ ".git"+expandUrl ('g':'h':':':xs) = "git@github.com:" ++ xs ++ ".git"+expandUrl xs = xs  -- | Clone given repository to current directory-clone :: String -> IO ExitCode-clone repoUrl = do-    _ <- system $ "git clone --no-checkout --quiet --depth=1 " ++ repoUrl ++ " " ++ "./"-    system "git checkout HEAD --quiet"+clone :: String -> IO ()+clone repoUrl = handle (\(e :: IOException) -> print e >> exitFailure) $ do+    callCommand $ "git clone --no-checkout --quiet " ++ repoUrl ++ " " ++ "./"+    callCommand "git checkout HEAD --quiet"  -- | Return file list by `git ls-files` lsFiles :: IO [String] lsFiles = lines <$> readProcess "git" ["ls-files"] []++-- | Return given config value+config :: String -> IO (Maybe String)+config name = do+    (exitCode,s,_) <- readProcessWithExitCode "git" ["config", name] []+    return $ if exitCode == ExitSuccess+               then Just $ removeNewline s+               else Nothing++removeNewline :: String -> String+removeNewline = reverse . dropWhile (=='\n') . reverse

@@ -1,179 +1,84 @@+{-# LANGUAGE NamedFieldPuns    #-} {-# LANGUAGE OverloadedStrings #-}  module Hi.Option     (-      getOptions-    , getMode-    , options-    , usage+      buildOption     ) where -import           Hi.Config             (parseConfig)+import           Hi.CommandLineOption (CommandLineOption)+import qualified Hi.CommandLineOption as CommandLineOption+import           Hi.Config            (parseConfig)+import qualified Hi.Git               as Git import           Hi.Types-import           Hi.Utils  import           Control.Applicative-import           Data.Char             (isUpper, toLower)-import           Data.List             (intercalate)-import           Data.Maybe            (fromMaybe, mapMaybe)-import           Data.Time.Calendar    (toGregorian)-import           Data.Time.Clock       (getCurrentTime, utctDay)-import           System.Console.GetOpt-import           System.Directory      (doesFileExist, getHomeDirectory)-import qualified System.Environment-import           System.FilePath       (joinPath)---- | Available options.-options :: [OptDescr Option]-options =-    [ Option ['m'] ["module-name"]        (ReqArg (Arg "moduleName" ) "Module.Name" ) "Name of Module"-    , Option ['p'] ["package-name"]       (ReqArg (Arg "packageName") "package-name") "Name of package        ( optional )"-    , Option ['a'] ["author"]             (ReqArg (Arg "author"     ) "NAME"        ) "Name of the project's author"-    , Option ['e'] ["email"]              (ReqArg (Arg "email"      ) "EMAIL"       ) "Email address of the maintainer"-    , Option ['r'] ["repository"]         (ReqArg (Arg "repository" ) "REPOSITORY"  ) "Template repository    ( optional )"-    , Option []    ["configuration-file"] (ReqArg (Arg "configFile" ) "CONFIGFILE"  ) "Run with configuration file"-    , Option ['v'] ["version"]            (NoArg  Version)                            "Show version number"-    , Option []    ["initialize-git-repository"] (NoArg InitializeGitRepository)      "Initialize with git repository"-    , Option ['h'] ["help"]               (NoArg  Help)                               "Display this help and exit"-    ]--toOption :: (String, String) -> Maybe Option-toOption (key, value) = maybe err ok $ key `lookupOption` options-  where-    err = error $ "Invalid options \"" ++ key ++ "\" was specified"-    ok (Option _ _ argDescr _) = toOption' argDescr value-    lookupOption :: String -> [OptDescr Option] -> Maybe (OptDescr Option)-    lookupOption k opts = k `lookup` map (\x@(Option _ (longOpt:_) _ _) -> (longOpt,x)) opts-    toOption' :: ArgDescr Option -> String -> Maybe Option-    toOption' (NoArg opt) "True" = Just opt-    toOption' (NoArg _) _        = Nothing-    toOption' (ReqArg f _) val   = Just $ f val+import           Control.Monad+import           Data.Char            (toUpper)+import           Data.Maybe           (fromMaybe)+import           Data.Time.Calendar   (toGregorian)+import           Data.Time.Clock      (getCurrentTime, utctDay) --- | Returns 'Options'.-getOptions :: IO [Option]-getOptions = handleError-               <$> validateOptions-               =<< addDefaultRepo-               =<< addPackageNameIfMissing-               =<< addOptionsFromConfigFile-               =<< addYear-               =<< parseOptions-               <$> System.Environment.getArgs+buildOption :: CommandLineOption -> IO Option+buildOption copt = do+    let moduleName = modularize $ CommandLineOption.packageName copt+    year <- getCurrentYear+    author <- guessAuthor+    email <- guessEmail+    return Option { initializeGitRepository = fromMaybe False $ CommandLineOption.initializeGitRepository copt+                  , moduleName     = fromMaybe moduleName $ CommandLineOption.moduleName copt+                  , packageName    = CommandLineOption.packageName copt+                  , author         = author+                  , email          = email+                  , templateSource = FromRepo $ CommandLineOption.repository copt+                  , year           = year+                  }   where-    addYear :: [Option] -> IO [Option]-    addYear vals = do-        y  <- getCurrentYear-        return $ vals ++ [y]--    addOptionsFromConfigFile :: [Option] -> IO [Option]-    addOptionsFromConfigFile vals = do-        repo <- do-            mfile <- readFileMaybe =<< getConfigFileName-            return $ mapMaybe toOption $ fromMaybe [] (parseConfig <$> mfile)-        return $ vals ++ repo--    addDefaultRepo :: [Option] -> IO [Option]-    addDefaultRepo vals = return $ vals ++ [Arg "repository" defaultRepo]--    addPackageNameIfMissing :: [Option] -> IO [Option]-    addPackageNameIfMissing vals =-        return $ case ("packageName" `lookupArg` vals, "moduleName" `lookupArg` vals) of-          (Nothing, Just m)  -> vals ++ [Arg "packageName" $ (removeDup . hyphenize) m]-          _                  -> vals-      where-        removeDup []           = []-        removeDup [x]          = [x]-        removeDup ('-':'-':xs) = removeDup('-':xs)-        removeDup (x:xs)       = x: removeDup xs-        hyphenize  []     = []-        hyphenize  (x:xs) = hyphenize' $ toLower x:xs-        hyphenize' []     = []-        hyphenize' (x:[]) = [toLower x]-        hyphenize' (x:xs) | isUpper x = '-':toLower x:hyphenize' xs-                          |  x == '.' = '-':hyphenize' xs-                          | otherwise = x:hyphenize' xs--    handleError :: Either [String] [Option] -> IO [Option]-    handleError result = case result of-        Left  errors -> error $ (intercalate "\n" errors) ++ "\n (Run with no arguments to see usage)"-        Right x      -> return x+    lookupConfig :: String -> IO (Maybe String)+    lookupConfig k = case CommandLineOption.configFilePath copt of+                       Just path -> lookup k . parseConfig <$> readFile path+                       Nothing   -> return Nothing+    choice :: [IO (Maybe String)] -> IO (Maybe String)+    choice xs = foldr1 mplus <$> sequence xs+    guessAuthor :: IO String+    guessAuthor = do+      mc <- choice [ return $ CommandLineOption.author copt+                   , lookupConfig "author"+                   , Git.config "user.name"+                   ]+      case mc of+        Just x -> return x+        Nothing -> fail "No user specified"+    guessEmail :: IO String+    guessEmail  = do+      mc <- choice [ return $ CommandLineOption.email copt+                   , lookupConfig "email"+                   , Git.config "user.email"+                   ]+      case mc of+        Just x -> return x+        Nothing -> fail "No email specified"+    getCurrentYear :: IO String+    getCurrentYear  = do+        (y,_,_) <- (toGregorian . utctDay) <$> getCurrentTime+        return $ show y --- | Return file contents in Maybe String or Nothing.+-- | Capitalize words and connect them with periods ---readFileMaybe :: FilePath -> IO (Maybe String)-readFileMaybe f = do-    e <- doesFileExist f-    if e then Just <$> readFile f else return Nothing---- | Returns 'Mode'.-getMode :: IO Mode-getMode = do-    args <- parseOptions <$> System.Environment.getArgs-    return $ modeFor args-  where-    modeFor args | Help `elem` args    = ShowHelp-                 | Version `elem` args = ShowVersion-                 | otherwise           = Run--parseOptions :: [String] -> [Option]-parseOptions argv =-  case getOpt Permute options argv of-    ([],_,errs) -> error $ concat errs ++ usage-    (o,_,[]   ) -> o-    (_,_,errs ) -> error $ concat errs ++ usage--usage :: String-usage = usageInfo header options ++ footer-  where-    header = "Usage: hi [OPTION...]\n" ++-             "Generate a haskell project based on a template from github.\n"-    footer = "\n" ++-             "If repository is not provided, it defaults to the repository at\n" ++-             defaultRepo ++ ".\n" ++-             "\n" ++-             "Example:\n" ++-             "    hi --module-name 'Foo.Bar' " ++-             "--author 'you' --email 'you@gmail.com'"--defaultConfigFilePath :: IO FilePath-defaultConfigFilePath = do-    h <- getHomeDirectory-    return $ joinPath [h, defaultConfigFileName]--defaultConfigFileName :: FilePath-defaultConfigFileName = ".hirc"--defaultRepo :: String-defaultRepo = "git://github.com/fujimura/hi-hspec.git"--getConfigFileName :: IO FilePath-getConfigFileName = go =<< parseOptions <$> System.Environment.getArgs+-- >>> modularize "package"+-- "Package"+--+-- >>> modularize "package-name"+-- "Package.Name"+--+-- >>> modularize "another-package-name"+-- "Another.Package.Name"+--+modularize :: String -> String+modularize []     = []+modularize [x]    = [toUpper x]+modularize (x:xs) = toUpper x : rest xs   where-    go []                       = defaultConfigFilePath-    go ((Arg "configFile" p):_) = return p-    go (_:xs)                   = go xs--getCurrentYear :: IO Option-getCurrentYear  = do-    (y,_,_) <- (toGregorian . utctDay) <$> getCurrentTime-    return (Arg "year" $ show y)---- | Validate given options-validateOptions :: [Option] -> Either [Error] [Option]-validateOptions values = case mapMaybe ($ values) validations of-                       []      -> Right values-                       errors  -> Left errors--validations ::[[Option] -> Maybe String]-validations = [ hasKey "packageName"-              , hasKey "moduleName"-              , hasKey "author"-              , hasKey "email"-              , hasKey "repository"-              , hasKey "year"-              ]--hasKey :: String -> [Option] -> Maybe String-hasKey k options = case lookupArg k options of-                      Just _  -> Nothing-                      Nothing -> Just $ "Could not find option: " ++ k+    rest []       = []+    rest ('-':ys) = '.' : modularize ys+    rest (y:ys)   = y:rest ys

@@ -16,11 +16,10 @@ import           Data.List.Split     (splitOn)  -- | Read templates in given 'FilePath'-readTemplates :: FilePath -> IO Files-readTemplates repo =+readTemplates :: TemplateSource -> IO Files+readTemplates (FromRepo repo) =     inTemporaryDirectory "hi" $ do-        -- TODO Handle error-        _ <- Git.clone $ Git.expandUrl repo+        Git.clone $ Git.expandUrl repo         paths <- Git.lsFiles         mapM fetchFile paths 

@@ -1,26 +1,27 @@ {-# LANGUAGE OverloadedStrings #-}  module Hi.Types-    ( Label-    , Option(..)-    , Mode(..)+    ( Option(..)     , File(..)     , Files-    , Error+    , TemplateSource (..)     ) where  import Data.ByteString (ByteString) -data File = TemplateFile { getFilePath :: FilePath, getFileContents :: ByteString } | RegularFile { getFilePath :: FilePath, getFileContents :: ByteString }--type Files = [File]--type Error = String+data File = TemplateFile { getFilePath :: FilePath, getFileContents :: ByteString } |+            RegularFile  { getFilePath :: FilePath, getFileContents :: ByteString } deriving (Show) -type Label = String+data TemplateSource = FromRepo String deriving (Eq,Ord,Show) --- | Options-data Option = Version | Help | InitializeGitRepository | Arg Label String deriving(Eq, Show)+type Files = [File] --- | Run mode.-data Mode = ShowVersion | ShowHelp | Run deriving(Eq, Show)+data Option = Option+             { initializeGitRepository :: Bool+             , moduleName :: String+             , packageName :: String+             , author :: String+             , email :: String+             , year :: String+             , templateSource :: TemplateSource+             } deriving (Eq,Ord,Show)

@@ -1,6 +0,0 @@-module Hi.Utils where--import           Hi.Types--lookupArg :: String -> [Option] -> Maybe String-lookupArg key xs = lookup key [(k,v) | (Arg k v) <- xs]

@@ -1,7 +0,0 @@-module Hi.Version-    (-      version-    ) where--version :: String-version = "0.0.8.2"

@@ -1,14 +1,9 @@-module Main where+module Main+  ( main+  ) where -import           Hi         (run)-import           Hi.Option  (getOptions, getMode, usage)-import           Hi.Types-import           Hi.Version (version)+import           Hi.Cli             (run)+import           System.Environment (getArgs)  main :: IO ()-main = do-    mode <- getMode-    case mode of-      ShowHelp -> putStrLn usage-      ShowVersion -> putStrLn version-      _           -> run =<< getOptions+main = getArgs >>= run

@@ -2,4 +2,10 @@ import           System.Process import           Test.DocTest -main = doctest =<< lines <$> readProcess "git" ["ls-files", "src"] []+main = do+    files <- lines <$> readProcess "git" ["ls-files", "src"] []+    doctest $ ["-idist/build/"+              ,"-idist/build/autogen"+              ,"-optP-include"+              ,"-optPdist/build/autogen/cabal_macros.h"+              ] ++ files