hi 0.0.4 → 0.0.5
raw patch · 24 files changed
+389/−383 lines, 24 filesdep ~hspecPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: hspec
API changes (from Hackage documentation)
- Distribution.Hi: cli :: InitFlags -> IO ()
- Distribution.Hi.Compiler: compile :: FilePath -> FilePath -> Context -> IO ()
- Distribution.Hi.Config: parseConfig :: String -> [Arg]
- Distribution.Hi.Context: context :: InitFlags -> Context
- Distribution.Hi.Directory: inDirectory :: FilePath -> (IO a -> IO a)
- Distribution.Hi.Directory: inTemporaryDirectory :: String -> (IO a -> IO a)
- Distribution.Hi.FilePath: toDestionationPath :: InitFlags -> FilePath -> FilePath
- Distribution.Hi.Flag: extractInitFlags :: [Arg] -> InitFlags
- Distribution.Hi.Option: getInitFlags :: IO InitFlags
- Distribution.Hi.Option: getMode :: IO Mode
- Distribution.Hi.Template: untemplate :: FilePath -> FilePath
- Distribution.Hi.Template: withTemplatesFromRepo :: String -> ([FilePath] -> IO a) -> IO a
- Distribution.Hi.Types: InitFlags :: !Flag -> !Flag -> !Flag -> !Flag -> !Flag -> !Flag -> InitFlags
- Distribution.Hi.Types: NoConfigurationFile :: Arg
- Distribution.Hi.Types: Run :: Mode
- Distribution.Hi.Types: RunWithNoConfigurationFile :: Mode
- Distribution.Hi.Types: ShowVersion :: Mode
- Distribution.Hi.Types: Val :: Label -> String -> Arg
- Distribution.Hi.Types: Version :: Arg
- Distribution.Hi.Types: author :: InitFlags -> !Flag
- Distribution.Hi.Types: data Arg
- Distribution.Hi.Types: data InitFlags
- Distribution.Hi.Types: data Mode
- Distribution.Hi.Types: email :: InitFlags -> !Flag
- Distribution.Hi.Types: instance Eq Arg
- Distribution.Hi.Types: instance Eq InitFlags
- Distribution.Hi.Types: instance Eq Mode
- Distribution.Hi.Types: instance Show Arg
- Distribution.Hi.Types: instance Show InitFlags
- Distribution.Hi.Types: instance Show Mode
- Distribution.Hi.Types: moduleName :: InitFlags -> !Flag
- Distribution.Hi.Types: packageName :: InitFlags -> !Flag
- Distribution.Hi.Types: repository :: InitFlags -> !Flag
- Distribution.Hi.Types: type Flag = String
- Distribution.Hi.Types: type Label = String
- Distribution.Hi.Types: year :: InitFlags -> !Flag
- Distribution.Hi.Version: version :: String
+ Hi: cli :: InitFlags -> IO ()
+ Hi: green :: String -> String
+ Hi.Compiler: compile :: FilePath -> FilePath -> Context -> IO ()
+ Hi.Config: parseConfig :: String -> [Arg]
+ Hi.Context: context :: InitFlags -> Context
+ Hi.Directory: inDirectory :: FilePath -> (IO a -> IO a)
+ Hi.Directory: inTemporaryDirectory :: String -> (IO a -> IO a)
+ Hi.FilePath: toDestionationPath :: InitFlags -> FilePath -> FilePath
+ Hi.Flag: extractInitFlags :: [Arg] -> InitFlags
+ Hi.Option: getInitFlags :: IO InitFlags
+ Hi.Option: getMode :: IO Mode
+ Hi.Template: untemplate :: FilePath -> FilePath
+ Hi.Template: withTemplatesFromRepo :: String -> ([FilePath] -> IO a) -> IO a
+ Hi.Types: InitFlags :: !Flag -> !Flag -> !Flag -> !Flag -> !Flag -> !Flag -> InitFlags
+ Hi.Types: NoConfigurationFile :: Arg
+ Hi.Types: Run :: Mode
+ Hi.Types: RunWithNoConfigurationFile :: Mode
+ Hi.Types: ShowVersion :: Mode
+ Hi.Types: Val :: Label -> String -> Arg
+ Hi.Types: Version :: Arg
+ Hi.Types: author :: InitFlags -> !Flag
+ Hi.Types: data Arg
+ Hi.Types: data InitFlags
+ Hi.Types: data Mode
+ Hi.Types: email :: InitFlags -> !Flag
+ Hi.Types: instance Eq Arg
+ Hi.Types: instance Eq InitFlags
+ Hi.Types: instance Eq Mode
+ Hi.Types: instance Show Arg
+ Hi.Types: instance Show InitFlags
+ Hi.Types: instance Show Mode
+ Hi.Types: moduleName :: InitFlags -> !Flag
+ Hi.Types: packageName :: InitFlags -> !Flag
+ Hi.Types: repository :: InitFlags -> !Flag
+ Hi.Types: type Flag = String
+ Hi.Types: type Label = String
+ Hi.Types: year :: InitFlags -> !Flag
+ Hi.Version: version :: String
Files
- hi.cabal +13/−13
- src/Distribution/Hi.hs +0/−27
- src/Distribution/Hi/Compiler.hs +0/−17
- src/Distribution/Hi/Config.hs +0/−46
- src/Distribution/Hi/Context.hs +0/−21
- src/Distribution/Hi/Directory.hs +0/−23
- src/Distribution/Hi/FilePath.hs +0/−28
- src/Distribution/Hi/Flag.hs +0/−37
- src/Distribution/Hi/Option.hs +0/−99
- src/Distribution/Hi/Template.hs +0/−32
- src/Distribution/Hi/Types.hs +0/−29
- src/Distribution/Hi/Version.hs +0/−7
- src/Hi.hs +33/−0
- src/Hi/Compiler.hs +17/−0
- src/Hi/Config.hs +46/−0
- src/Hi/Context.hs +21/−0
- src/Hi/Directory.hs +23/−0
- src/Hi/FilePath.hs +28/−0
- src/Hi/Flag.hs +37/−0
- src/Hi/Option.hs +99/−0
- src/Hi/Template.hs +32/−0
- src/Hi/Types.hs +29/−0
- src/Hi/Version.hs +7/−0
- src/Main.hs +4/−4
hi.cabal view
@@ -1,5 +1,5 @@ name: hi-version: 0.0.4+version: 0.0.5 synopsis: Generate scaffold for cabal project license: BSD3 license-file: LICENSE@@ -51,17 +51,17 @@ library exposed-modules:- Distribution.Hi- Distribution.Hi.Compiler- Distribution.Hi.Config- Distribution.Hi.Context- Distribution.Hi.Directory- Distribution.Hi.FilePath- Distribution.Hi.Flag- Distribution.Hi.Option- Distribution.Hi.Template- Distribution.Hi.Types- Distribution.Hi.Version+ Hi+ Hi.Compiler+ Hi.Config+ Hi.Context+ Hi.Directory+ Hi.FilePath+ Hi.Flag+ Hi.Option+ Hi.Template+ Hi.Types+ Hi.Version ghc-options: -Wall hs-source-dirs:@@ -116,7 +116,7 @@ , HUnit , bytestring , directory- , hspec >= 1.5+ , hspec >= 1.7.2 , parsec , process , template == 0.2.*
− src/Distribution/Hi.hs
@@ -1,27 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-module Distribution.Hi where--import Distribution.Hi.Compiler (compile)-import Distribution.Hi.FilePath (toDestionationPath)-import Distribution.Hi.Context (context)-import Distribution.Hi.Types-import Distribution.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-- withTemplatesFromRepo repository $ \templates -> do-- let sourceAndDestinations = map (id &&& toDestionationPath initFlags) templates-- forM_ sourceAndDestinations $ \(src,dst) -> do- let dst' = joinPath [currentDirecotory, dst]- createDirectoryIfMissing True $ dropFileName dst'- compile src dst' $ context initFlags
− src/Distribution/Hi/Compiler.hs
@@ -1,17 +0,0 @@-module Distribution.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/Distribution/Hi/Config.hs
@@ -1,46 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}-module Distribution.Hi.Config- (- parseConfig- ) where--import Control.Applicative ((<$>), (<*))-import Data.Maybe (catMaybes)-import Distribution.Hi.Types-import Text.Parsec-import Text.Parsec.String--sep :: Parser Char-sep = char ':'--name :: Parser String-name = many (oneOf $ ['a'..'z'] ++ ['A'..'Z'])--eol :: Parser Char-eol = newline <|> (eof >> return '\n')--comment :: Parser ()-comment = do- _ <- char '#' <* manyTill anyChar newline- return ()--line :: Parser (Maybe (String, String))-line = do- spaces- try (comment >> return Nothing) <|> (line' >>= return . Just)- where- line' = do- spaces- n <- name- spaces >> sep >> spaces- v <- many (noneOf "\n")- eol- return (n, v)--configFile :: Parser [(String, String)]-configFile = catMaybes <$> many line <* eof--parseConfig :: String -> [Arg]-parseConfig x = case parse configFile "ERROR" x of -- TODO Error message- Left l -> error $ show l- Right xs -> map (uncurry Val) xs
− src/Distribution/Hi/Context.hs
@@ -1,21 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-module Distribution.Hi.Context- (- context- ) where--import Distribution.Hi.Types-import qualified Data.Text as T-import Data.Text.Template (Context)---- | Create a 'Context' from 'InitFlags Will raise error if the key was not found.-context :: InitFlags -> Context-context (InitFlags {..}) x = T.pack . lookup' $ T.unpack x- -- TODO FIXME boilerplate- where lookup' "packageName" = packageName- lookup' "moduleName" = moduleName- lookup' "author" = author- lookup' "email" = email- lookup' "repository" = repository- lookup' "year" = year- lookup' k = error $ "Key is not defined: " ++ k
− src/Distribution/Hi/Directory.hs
@@ -1,23 +0,0 @@-module Distribution.Hi.Directory- (- inDirectory- , inTemporaryDirectory- ) where--import Control.Exception (bracket_)-import System.Directory-import System.IO.Temp (withSystemTempDirectory)---- |Run callback in a temporary directory.-inTemporaryDirectory :: String -- ^ Base of temorary directory name- -> (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-inDirectory path callback = do- pwd <- getCurrentDirectory- bracket_ (setCurrentDirectory path) (setCurrentDirectory pwd) callback
− src/Distribution/Hi/FilePath.hs
@@ -1,28 +0,0 @@-module Distribution.Hi.FilePath- (- toDestionationPath- ) where--import Distribution.Hi.Types-import Distribution.Hi.Template (untemplate)-import Data.List-import Data.List.Split (splitOn)-import System.FilePath (joinPath)---- | Convert given path to the destination path, with given options.-toDestionationPath :: InitFlags -> FilePath -> FilePath-toDestionationPath InitFlags {moduleName=m, packageName=p} =- rename1 . rename2 . untemplate- where- rename1 = replace "package-name" p- rename2 = replace "ModuleName" (toDir m)---- | Convert module name to path--- @--- toDir "Foo.bar" # => "Foo/Bar"--- @-toDir :: String -> String-toDir = joinPath . splitOn "."--replace :: Eq a => [a] -> [a] -> [a] -> [a]-replace a b = foldl1 (++) . intersperse b . splitOn a
− src/Distribution/Hi/Flag.hs
@@ -1,37 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Distribution.Hi.Flag- (- extractInitFlags- ) where--import Distribution.Hi.Types---- | Extract 'InitFlags' from a list of 'Arg'-extractInitFlags :: [Arg] -> InitFlags-extractInitFlags args = InitFlags { packageName = lookupPackageName- , moduleName = lookupModuleName- , author = lookupAuthor- , email = lookupEmail- , repository = lookupRepository- , year = lookupYear- }- where- lookupPackageName = lookup' "packageName"- lookupModuleName = lookup' "moduleName"- lookupAuthor = lookup' "author"- lookupEmail = lookup' "email"- lookupRepository = lookup' "repository"- lookupYear = lookup' "year"- lookup' label = case lookup label $ [(l, v) | (Val l v) <- args] of- Just v -> v- Nothing -> if label == "repository"- then defaultRepo- else error $ errorMessageFor label- errorMessageFor l = concat [ "Could not find option: "- , l- , "\n (Run with no arguments to see usage)"- ]--defaultRepo :: String-defaultRepo = "git://github.com/fujimura/hi-hspec.git"
− src/Distribution/Hi/Option.hs
@@ -1,99 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Distribution.Hi.Option- (- getInitFlags- , getMode- ) where--import Control.Applicative-import Control.Exception (IOException, catch)-import Data.Time.Calendar (toGregorian)-import Data.Time.Clock (getCurrentTime, utctDay)-import Distribution.Hi.Config (parseConfig)-import Distribution.Hi.Flag (extractInitFlags)-import Distribution.Hi.Types-import Prelude hiding (catch)-import System.Console.GetOpt-import System.Directory (getHomeDirectory)-import System.Environment (getArgs)-import System.FilePath (joinPath)-import System.IO (hPutStr, stderr)----- | Available options.-options :: [OptDescr Arg]-options =- [ Option ['p'] ["package-name"](ReqArg (Val "packageName") "package-name") "Name of package"- , Option ['m'] ["module-name"] (ReqArg (Val "moduleName") "Module.Name") "Name of Module"- , Option ['a'] ["author"] (ReqArg (Val "author") "NAME") "Name of the project's author"- , Option ['e'] ["email"] (ReqArg (Val "email") "EMAIL") "Email address of the maintainer"- , Option ['r'] ["repository"] (ReqArg (Val "repository") "REPOSITORY") "Template repository(optional)"- , Option ['v'] ["version"] (NoArg Version) "Show version number"- , Option [] ["no-configuration-file"] (NoArg NoConfigurationFile) "Run without configuration file"- , Option [] ["configuration-file"] (ReqArg (Val "configFile") "CONFIGFILE") "Run with configuration file"- ]---- | Returns 'InitFlags'.-getInitFlags :: IO InitFlags-getInitFlags = do- mode <- getMode- case mode of- Run -> runWithConfigurationFile- RunWithNoConfigurationFile -> runWithNoConfigurationFile- _ -> error "Unexpected run mode"- 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 "")---- | Returns `InitFlags` from given args, attaching year if it's missing in--- args-getInitFlags' :: [String] -> IO InitFlags-getInitFlags' args = extractInitFlags <$> (addYear . fst . parseArgs $ args)---- | Returns 'Mode'.-getMode :: IO Mode-getMode = do- go . fst . parseArgs <$> getArgs- where- go [] = Run- go (Version:_) = ShowVersion- go (NoConfigurationFile:_) = RunWithNoConfigurationFile- go (_:xs) = go xs--parseArgs :: [String] -> ([Arg], [String])-parseArgs argv =- case getOpt Permute options argv of- ([],_,errs) -> error $ concat errs ++ usageInfo header options- (o,n,[] ) -> (o,n)- (_,_,errs ) -> error $ concat errs ++ usageInfo header options- where- header = "Usage: hi [OPTION...]"--defaultConfigFilePath :: IO FilePath-defaultConfigFilePath = do- h <- getHomeDirectory- return $ joinPath [h, defaultConfigFileName]--defaultConfigFileName :: FilePath-defaultConfigFileName = ".hirc"--getConfigFileName :: IO FilePath-getConfigFileName = do- go =<< (fst . parseArgs) <$> getArgs- where- go [] = defaultConfigFilePath- go ((Val "configFile" p):_) = return p- go (_:xs) = go xs--addYear :: [Arg] -> IO [Arg]-addYear args = do- (y,_,_) <- (toGregorian . utctDay) <$> getCurrentTime- return $ (Val "year" $ show y):args
− src/Distribution/Hi/Template.hs
@@ -1,32 +0,0 @@-module Distribution.Hi.Template- (- withTemplatesFromRepo- , untemplate- ) where--import Distribution.Hi.Directory (inTemporaryDirectory)-import Data.List.Split (splitOn)-import System.Exit (ExitCode)-import System.FilePath.Glob (compile, globDir1)-import System.Process (system)---- | 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 =- inTemporaryDirectory "hi" $ do- -- TODO Handle error- _ <- cloneRepo repo- paths <- globDir1 (compile "./**/*.template") "./"- cb paths---- | Remove \".template\" from 'FilePath'-untemplate :: FilePath -> FilePath-untemplate = head . splitOn ".template"---- | Clone given repository to current directory-cloneRepo :: String -> IO ExitCode-cloneRepo repoUrl = do- _ <- system $ "git clone --no-checkout --quiet --depth=1 " ++ repoUrl ++ " ./"- system "git checkout HEAD --quiet"
− src/Distribution/Hi/Types.hs
@@ -1,29 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Distribution.Hi.Types- (- Flag- , InitFlags(..)- , Label- , Arg(..)- , Mode(..)- ) where--type Flag = String--data InitFlags =- InitFlags { packageName :: !Flag- , moduleName :: !Flag- , author :: !Flag- , email :: !Flag- , repository :: !Flag- , year :: !Flag- } deriving(Eq, Show)--type Label = String---- | Arguments.-data Arg = Version | NoConfigurationFile | Val Label String deriving(Eq, Show)---- | Run mode.-data Mode = ShowVersion | Run | RunWithNoConfigurationFile deriving(Eq, Show)
− src/Distribution/Hi/Version.hs
@@ -1,7 +0,0 @@-module Distribution.Hi.Version- (- version- ) where--version :: String-version = "0.0.4"
+ src/Hi.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE NamedFieldPuns #-}+module Hi where++import Hi.Compiler (compile)+import Hi.FilePath (toDestionationPath)+import Hi.Context (context)+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++ withTemplatesFromRepo repository $ \templates -> do++ let sourceAndDestinations = map (id &&& toDestionationPath initFlags) templates++ forM_ sourceAndDestinations $ \(src,dst) -> do+ let dst' = joinPath [currentDirecotory, dst]+ createDirectoryIfMissing True $ dropFileName dst'+ putStrLn $ " " ++ green "create" ++ " " ++ dst+ compile src dst' $ context initFlags++green :: String -> String+green x = "\x1b[32m" ++ x ++ "\x1b[0m"
+ src/Hi/Compiler.hs view
@@ -0,0 +1,17 @@+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/Config.hs view
@@ -0,0 +1,46 @@+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+module Hi.Config+ (+ parseConfig+ ) where++import Control.Applicative ((<$>), (<*))+import Data.Maybe (catMaybes)+import Hi.Types+import Text.Parsec+import Text.Parsec.String++sep :: Parser Char+sep = char ':'++name :: Parser String+name = many (oneOf $ ['a'..'z'] ++ ['A'..'Z'])++eol :: Parser Char+eol = newline <|> (eof >> return '\n')++comment :: Parser ()+comment = do+ _ <- char '#' <* manyTill anyChar newline+ return ()++line :: Parser (Maybe (String, String))+line = do+ spaces+ try (comment >> return Nothing) <|> (line' >>= return . Just)+ where+ line' = do+ spaces+ n <- name+ spaces >> sep >> spaces+ v <- many (noneOf "\n")+ eol+ return (n, v)++configFile :: Parser [(String, String)]+configFile = catMaybes <$> many line <* eof++parseConfig :: String -> [Arg]+parseConfig x = case parse configFile "ERROR" x of -- TODO Error message+ Left l -> error $ show l+ Right xs -> map (uncurry Val) xs
+ src/Hi/Context.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE RecordWildCards #-}+module Hi.Context+ (+ context+ ) where++import Hi.Types+import qualified Data.Text as T+import Data.Text.Template (Context)++-- | Create a 'Context' from 'InitFlags Will raise error if the key was not found.+context :: InitFlags -> Context+context (InitFlags {..}) x = T.pack . lookup' $ T.unpack x+ -- TODO FIXME boilerplate+ where lookup' "packageName" = packageName+ lookup' "moduleName" = moduleName+ lookup' "author" = author+ lookup' "email" = email+ lookup' "repository" = repository+ lookup' "year" = year+ lookup' k = error $ "Key is not defined: " ++ k
+ src/Hi/Directory.hs view
@@ -0,0 +1,23 @@+module Hi.Directory+ (+ inDirectory+ , inTemporaryDirectory+ ) where++import Control.Exception (bracket_)+import System.Directory+import System.IO.Temp (withSystemTempDirectory)++-- |Run callback in a temporary directory.+inTemporaryDirectory :: String -- ^ Base of temorary directory name+ -> (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+inDirectory path callback = do+ pwd <- getCurrentDirectory+ bracket_ (setCurrentDirectory path) (setCurrentDirectory pwd) callback
+ src/Hi/FilePath.hs view
@@ -0,0 +1,28 @@+module Hi.FilePath+ (+ toDestionationPath+ ) where++import Hi.Types+import Hi.Template (untemplate)+import Data.List+import Data.List.Split (splitOn)+import System.FilePath (joinPath)++-- | Convert given path to the destination path, with given options.+toDestionationPath :: InitFlags -> FilePath -> FilePath+toDestionationPath InitFlags {moduleName=m, packageName=p} =+ rename1 . rename2 . untemplate+ where+ rename1 = replace "package-name" p+ rename2 = replace "ModuleName" (toDir m)++-- | Convert module name to path+-- @+-- toDir "Foo.bar" # => "Foo/Bar"+-- @+toDir :: String -> String+toDir = joinPath . splitOn "."++replace :: Eq a => [a] -> [a] -> [a] -> [a]+replace a b = foldl1 (++) . intersperse b . splitOn a
+ src/Hi/Flag.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++module Hi.Flag+ (+ extractInitFlags+ ) where++import Hi.Types++-- | Extract 'InitFlags' from a list of 'Arg'+extractInitFlags :: [Arg] -> InitFlags+extractInitFlags args = InitFlags { packageName = lookupPackageName+ , moduleName = lookupModuleName+ , author = lookupAuthor+ , email = lookupEmail+ , repository = lookupRepository+ , year = lookupYear+ }+ where+ lookupPackageName = lookup' "packageName"+ lookupModuleName = lookup' "moduleName"+ lookupAuthor = lookup' "author"+ lookupEmail = lookup' "email"+ lookupRepository = lookup' "repository"+ lookupYear = lookup' "year"+ lookup' label = case lookup label $ [(l, v) | (Val l v) <- args] of+ Just v -> v+ Nothing -> if label == "repository"+ then defaultRepo+ else error $ errorMessageFor label+ errorMessageFor l = concat [ "Could not find option: "+ , l+ , "\n (Run with no arguments to see usage)"+ ]++defaultRepo :: String+defaultRepo = "git://github.com/fujimura/hi-hspec.git"
+ src/Hi/Option.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE OverloadedStrings #-}++module Hi.Option+ (+ getInitFlags+ , getMode+ ) where++import Control.Applicative+import Control.Exception (IOException, catch)+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.Environment (getArgs)+import System.FilePath (joinPath)+import System.IO (hPutStr, stderr)+++-- | Available options.+options :: [OptDescr Arg]+options =+ [ Option ['p'] ["package-name"](ReqArg (Val "packageName") "package-name") "Name of package"+ , Option ['m'] ["module-name"] (ReqArg (Val "moduleName") "Module.Name") "Name of Module"+ , Option ['a'] ["author"] (ReqArg (Val "author") "NAME") "Name of the project's author"+ , Option ['e'] ["email"] (ReqArg (Val "email") "EMAIL") "Email address of the maintainer"+ , Option ['r'] ["repository"] (ReqArg (Val "repository") "REPOSITORY") "Template repository(optional)"+ , Option ['v'] ["version"] (NoArg Version) "Show version number"+ , Option [] ["no-configuration-file"] (NoArg NoConfigurationFile) "Run without configuration file"+ , Option [] ["configuration-file"] (ReqArg (Val "configFile") "CONFIGFILE") "Run with configuration file"+ ]++-- | Returns 'InitFlags'.+getInitFlags :: IO InitFlags+getInitFlags = do+ mode <- getMode+ case mode of+ Run -> runWithConfigurationFile+ RunWithNoConfigurationFile -> runWithNoConfigurationFile+ _ -> error "Unexpected run mode"+ 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 "")++-- | Returns `InitFlags` from given args, attaching year if it's missing in+-- args+getInitFlags' :: [String] -> IO InitFlags+getInitFlags' args = extractInitFlags <$> (addYear . fst . parseArgs $ args)++-- | Returns 'Mode'.+getMode :: IO Mode+getMode = do+ go . fst . parseArgs <$> getArgs+ where+ go [] = Run+ go (Version:_) = ShowVersion+ go (NoConfigurationFile:_) = RunWithNoConfigurationFile+ go (_:xs) = go xs++parseArgs :: [String] -> ([Arg], [String])+parseArgs argv =+ case getOpt Permute options argv of+ ([],_,errs) -> error $ concat errs ++ usageInfo header options+ (o,n,[] ) -> (o,n)+ (_,_,errs ) -> error $ concat errs ++ usageInfo header options+ where+ header = "Usage: hi [OPTION...]"++defaultConfigFilePath :: IO FilePath+defaultConfigFilePath = do+ h <- getHomeDirectory+ return $ joinPath [h, defaultConfigFileName]++defaultConfigFileName :: FilePath+defaultConfigFileName = ".hirc"++getConfigFileName :: IO FilePath+getConfigFileName = do+ go =<< (fst . parseArgs) <$> getArgs+ where+ go [] = defaultConfigFilePath+ go ((Val "configFile" p):_) = return p+ go (_:xs) = go xs++addYear :: [Arg] -> IO [Arg]+addYear args = do+ (y,_,_) <- (toGregorian . utctDay) <$> getCurrentTime+ return $ (Val "year" $ show y):args
+ src/Hi/Template.hs view
@@ -0,0 +1,32 @@+module Hi.Template+ (+ withTemplatesFromRepo+ , 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)++-- | 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 =+ inTemporaryDirectory "hi" $ do+ -- TODO Handle error+ _ <- cloneRepo repo+ paths <- globDir1 (compile "**/*.template") "./"+ cb paths++-- | Remove \".template\" from 'FilePath'+untemplate :: FilePath -> FilePath+untemplate = head . splitOn ".template"++-- | Clone given repository to current directory+cloneRepo :: String -> IO ExitCode+cloneRepo repoUrl = do+ _ <- system $ "git clone --no-checkout --quiet --depth=1 " ++ repoUrl ++ " ./"+ system "git checkout HEAD --quiet"
+ src/Hi/Types.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module Hi.Types+ (+ Flag+ , InitFlags(..)+ , Label+ , Arg(..)+ , Mode(..)+ ) where++type Flag = String++data InitFlags =+ InitFlags { packageName :: !Flag+ , moduleName :: !Flag+ , author :: !Flag+ , email :: !Flag+ , repository :: !Flag+ , year :: !Flag+ } deriving(Eq, Show)++type Label = String++-- | Arguments.+data Arg = Version | NoConfigurationFile | Val Label String deriving(Eq, Show)++-- | Run mode.+data Mode = ShowVersion | Run | RunWithNoConfigurationFile deriving(Eq, Show)
+ src/Hi/Version.hs view
@@ -0,0 +1,7 @@+module Hi.Version+ (+ version+ ) where++version :: String+version = "0.0.5"
src/Main.hs view
@@ -1,9 +1,9 @@ module Main where -import qualified Distribution.Hi as Hi-import Distribution.Hi.Option (getInitFlags, getMode)-import Distribution.Hi.Types-import Distribution.Hi.Version (version)+import qualified Hi as Hi+import Hi.Option (getInitFlags, getMode)+import Hi.Types+import Hi.Version (version) main :: IO () main = do