packages feed

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 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