diff --git a/hi.cabal b/hi.cabal --- a/hi.cabal +++ b/hi.cabal @@ -1,5 +1,5 @@ name: hi -version: 0.0.5 +version: 0.0.6 synopsis: Generate scaffold for cabal project license: BSD3 license-file: LICENSE @@ -52,7 +52,6 @@ library exposed-modules: Hi - Hi.Compiler Hi.Config Hi.Context Hi.Directory @@ -68,7 +67,6 @@ src build-depends: base == 4.* - , Glob , bytestring , directory , filepath @@ -89,7 +87,6 @@ src build-depends: base == 4.* - , Glob , bytestring , directory , filepath diff --git a/src/Hi.hs b/src/Hi.hs --- a/src/Hi.hs +++ b/src/Hi.hs @@ -1,33 +1,49 @@ {-# LANGUAGE NamedFieldPuns #-} -module Hi where +module Hi + ( + run + ) where -import Hi.Compiler (compile) -import Hi.FilePath (toDestionationPath) -import Hi.Context (context) +import Hi.Context (context) +import Hi.FilePath (rewritePath) +import Hi.Template (readTemplates) import Hi.Types -import Hi.Template (withTemplatesFromRepo) -import Control.Arrow ((&&&)) -import Control.Monad -import System.Directory (createDirectoryIfMissing, - getCurrentDirectory) -import System.FilePath (joinPath, dropFileName) --- | Main function -cli :: InitFlags -> IO () -cli initFlags@(InitFlags {repository}) = do - currentDirecotory <- getCurrentDirectory - - putStrLn $ "Creating new project from repository: " ++ repository +import Control.Applicative +import Data.List (isSuffixOf) +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import Data.Text.Template (substitute) +import System.Directory (createDirectoryIfMissing) +import System.FilePath (dropFileName) - withTemplatesFromRepo repository $ \templates -> do +writeFiles :: Files -> IO () +writeFiles = mapM_ (uncurry write) + where + write :: FilePath -> String -> IO () + write path content = do + createDirectoryIfMissing True $ dropFileName path + writeFile path content - let sourceAndDestinations = map (id &&& toDestionationPath initFlags) templates +process :: InitFlags -> Files -> Files +process initFlags files = map go $ filter isTemplate files + where + isTemplate (path,_) = ".template" `isSuffixOf` path + go (path, content) = (rewritePath initFlags path, substitute' content) + substitute' t = LT.unpack $ substitute (T.pack t) (context initFlags) - forM_ sourceAndDestinations $ \(src,dst) -> do - let dst' = joinPath [currentDirecotory, dst] - createDirectoryIfMissing True $ dropFileName dst' - putStrLn $ " " ++ green "create" ++ " " ++ dst - compile src dst' $ context initFlags +showFileList :: Files -> IO Files +showFileList files = do + mapM_ (showFile . fst) files + return files + where + showFile :: FilePath -> IO () + showFile path = putStrLn $ " " ++ green "create" ++ " " ++ path green :: String -> String green x = "\x1b[32m" ++ x ++ "\x1b[0m" + +run :: InitFlags -> IO () +run initFlags@(InitFlags {repository}) = do + putStrLn $ "Creating new project from repository: " ++ repository + writeFiles =<< showFileList =<< process initFlags <$> readTemplates repository diff --git a/src/Hi/Compiler.hs b/src/Hi/Compiler.hs deleted file mode 100644 --- a/src/Hi/Compiler.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Hi.Compiler - ( - compile - ) where - -import qualified Data.Text.IO as T -import qualified Data.Text.Lazy.IO as LT -import Data.Text.Template (Context, substitute) - --- | Compile a file from template with given 'Context'. -compile :: FilePath -- Source - -> FilePath -- Destionation - -> Context -- Context - -> IO () -compile src dst ctx = do - tmpl <- T.readFile src - LT.writeFile dst $ substitute tmpl ctx diff --git a/src/Hi/Directory.hs b/src/Hi/Directory.hs --- a/src/Hi/Directory.hs +++ b/src/Hi/Directory.hs @@ -1,7 +1,7 @@ module Hi.Directory ( - inDirectory - , inTemporaryDirectory + inTemporaryDirectory + , inDirectory ) where import Control.Exception (bracket_) @@ -9,7 +9,7 @@ import System.IO.Temp (withSystemTempDirectory) -- |Run callback in a temporary directory. -inTemporaryDirectory :: String -- ^ Base of temorary directory name +inTemporaryDirectory :: String -- ^ Base of temporary directory name -> (IO a -> IO a) -- ^ Callback inTemporaryDirectory name callback = withSystemTempDirectory name $ flip inDirectory callback diff --git a/src/Hi/FilePath.hs b/src/Hi/FilePath.hs --- a/src/Hi/FilePath.hs +++ b/src/Hi/FilePath.hs @@ -1,6 +1,6 @@ module Hi.FilePath ( - toDestionationPath + rewritePath ) where import Hi.Types @@ -10,8 +10,8 @@ import System.FilePath (joinPath) -- | Convert given path to the destination path, with given options. -toDestionationPath :: InitFlags -> FilePath -> FilePath -toDestionationPath InitFlags {moduleName=m, packageName=p} = +rewritePath :: InitFlags -> FilePath -> FilePath +rewritePath InitFlags {moduleName=m, packageName=p} = rename1 . rename2 . untemplate where rename1 = replace "package-name" p diff --git a/src/Hi/Option.hs b/src/Hi/Option.hs --- a/src/Hi/Option.hs +++ b/src/Hi/Option.hs @@ -7,18 +7,16 @@ ) where import Control.Applicative -import Control.Exception (IOException, catch) +import Data.Maybe (fromMaybe) import Data.Time.Calendar (toGregorian) import Data.Time.Clock (getCurrentTime, utctDay) import Hi.Config (parseConfig) import Hi.Flag (extractInitFlags) import Hi.Types -import Prelude hiding (catch) import System.Console.GetOpt -import System.Directory (getHomeDirectory) +import System.Directory (getHomeDirectory, doesFileExist) import System.Environment (getArgs) import System.FilePath (joinPath) -import System.IO (hPutStr, stderr) -- | Available options. @@ -45,34 +43,42 @@ where runWithNoConfigurationFile = getInitFlags' =<< getArgs runWithConfigurationFile = do - (xs,_) <- parseArgs <$> getArgs - ys <- addYear <$> parseConfig =<< readFile' =<< getConfigFileName - return $ extractInitFlags (ys ++ xs) - readFile' f = catch (readFile f) - (\e -> do let err = show (e :: IOException) - hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err) - return "") + xs <- parseArgs <$> getArgs + y <- getCurrentYear + ys <- do + mfile <- readFileMaybe =<< getConfigFileName + return $ fromMaybe [] (parseConfig <$> mfile) + return $ extractInitFlags (xs ++ ys ++ [y]) +-- | Return file contents in Maybe String or Nothing. +-- +readFileMaybe :: FilePath -> IO (Maybe String) +readFileMaybe f = do + e <- doesFileExist f + if e then Just <$> readFile f else return Nothing + -- | Returns `InitFlags` from given args, attaching year if it's missing in -- args getInitFlags' :: [String] -> IO InitFlags -getInitFlags' args = extractInitFlags <$> (addYear . fst . parseArgs $ args) +getInitFlags' args = do + y <- getCurrentYear + return $ extractInitFlags $ (parseArgs $ args) ++ [y] -- | Returns 'Mode'. getMode :: IO Mode getMode = do - go . fst . parseArgs <$> getArgs + go . parseArgs <$> getArgs where go [] = Run go (Version:_) = ShowVersion go (NoConfigurationFile:_) = RunWithNoConfigurationFile go (_:xs) = go xs -parseArgs :: [String] -> ([Arg], [String]) +parseArgs :: [String] -> [Arg] parseArgs argv = case getOpt Permute options argv of ([],_,errs) -> error $ concat errs ++ usageInfo header options - (o,n,[] ) -> (o,n) + (o,_,[] ) -> o (_,_,errs ) -> error $ concat errs ++ usageInfo header options where header = "Usage: hi [OPTION...]" @@ -87,13 +93,13 @@ getConfigFileName :: IO FilePath getConfigFileName = do - go =<< (fst . parseArgs) <$> getArgs + go =<< parseArgs <$> getArgs where go [] = defaultConfigFilePath go ((Val "configFile" p):_) = return p go (_:xs) = go xs -addYear :: [Arg] -> IO [Arg] -addYear args = do +getCurrentYear :: IO Arg +getCurrentYear = do (y,_,_) <- (toGregorian . utctDay) <$> getCurrentTime - return $ (Val "year" $ show y):args + return $ (Val "year" $ show y) diff --git a/src/Hi/Template.hs b/src/Hi/Template.hs --- a/src/Hi/Template.hs +++ b/src/Hi/Template.hs @@ -1,25 +1,24 @@ module Hi.Template ( - withTemplatesFromRepo + readTemplates , untemplate ) where -import Hi.Directory (inTemporaryDirectory) -import Data.List.Split (splitOn) -import System.Exit (ExitCode) -import System.FilePath.Glob (compile, globDir1) -import System.Process (system) +import Hi.Directory (inTemporaryDirectory) +import Hi.Types +import Control.Applicative +import Data.List.Split (splitOn) +import System.Exit (ExitCode) +import System.Process (system, readProcess) --- | Run callback with list of template files. -withTemplatesFromRepo :: String -- ^ Repository url - -> ([FilePath] -> IO a) -- ^ Callback which takes list of the template file - -> IO a -- ^ Result -withTemplatesFromRepo repo cb = +readTemplates :: String -> IO Files +readTemplates repo = inTemporaryDirectory "hi" $ do -- TODO Handle error _ <- cloneRepo repo - paths <- globDir1 (compile "**/*.template") "./" - cb paths + paths <- lsFiles + contents <- mapM readFile paths + return $ zip paths contents -- | Remove \".template\" from 'FilePath' untemplate :: FilePath -> FilePath @@ -28,5 +27,9 @@ -- | Clone given repository to current directory cloneRepo :: String -> IO ExitCode cloneRepo repoUrl = do - _ <- system $ "git clone --no-checkout --quiet --depth=1 " ++ repoUrl ++ " ./" + _ <- system $ "git clone --no-checkout --quiet --depth=1 " ++ repoUrl ++ " " ++ "./" system "git checkout HEAD --quiet" + +-- | Return file list by `git ls-files` +lsFiles :: IO [String] +lsFiles = lines <$> readProcess "git" ["ls-files"] [] diff --git a/src/Hi/Types.hs b/src/Hi/Types.hs --- a/src/Hi/Types.hs +++ b/src/Hi/Types.hs @@ -7,7 +7,10 @@ , Label , Arg(..) , Mode(..) + , Files ) where + +type Files = [(FilePath, String)] type Flag = String diff --git a/src/Hi/Version.hs b/src/Hi/Version.hs --- a/src/Hi/Version.hs +++ b/src/Hi/Version.hs @@ -4,4 +4,4 @@ ) where version :: String -version = "0.0.5" +version = "0.0.6" diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -1,6 +1,6 @@ module Main where -import qualified Hi as Hi +import Hi (run) import Hi.Option (getInitFlags, getMode) import Hi.Types import Hi.Version (version) @@ -10,5 +10,5 @@ mode <- getMode case mode of ShowVersion -> putStrLn version - RunWithNoConfigurationFile -> Hi.cli =<< getInitFlags - Run -> Hi.cli =<< getInitFlags + RunWithNoConfigurationFile -> run =<< getInitFlags + Run -> run =<< getInitFlags