hi 0.0.5 → 0.0.6
raw patch · 10 files changed
+95/−87 lines, 10 filesdep −Glob
Dependencies removed: Glob
Files
- hi.cabal +1/−4
- src/Hi.hs +39/−23
- src/Hi/Compiler.hs +0/−17
- src/Hi/Directory.hs +3/−3
- src/Hi/FilePath.hs +3/−3
- src/Hi/Option.hs +25/−19
- src/Hi/Template.hs +17/−14
- src/Hi/Types.hs +3/−0
- src/Hi/Version.hs +1/−1
- src/Main.hs +3/−3
hi.cabal view
@@ -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
src/Hi.hs view
@@ -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
− src/Hi/Compiler.hs
@@ -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
src/Hi/Directory.hs view
@@ -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
src/Hi/FilePath.hs view
@@ -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
src/Hi/Option.hs view
@@ -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)
src/Hi/Template.hs view
@@ -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"] []
src/Hi/Types.hs view
@@ -7,7 +7,10 @@ , Label , Arg(..) , Mode(..)+ , Files ) where++type Files = [(FilePath, String)] type Flag = String
src/Hi/Version.hs view
@@ -4,4 +4,4 @@ ) where version :: String-version = "0.0.5"+version = "0.0.6"
src/Main.hs view
@@ -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