hi (empty) → 0.0.1

raw patch · 15 files changed

+443/−0 lines, 15 filesdep +Globdep +HUnitdep +basesetup-changed

Dependencies added: Glob, HUnit, base, bytestring, directory, filepath, hspec, process, split, template, temporary, text, time

Files

• LICENSE +30/−0
• Setup.hs +2/−0
• hi.cabal +124/−0
• src/Distribution/Hi.hs +27/−0
• src/Distribution/Hi/Compiler.hs +17/−0
• src/Distribution/Hi/Context.hs +21/−0
• src/Distribution/Hi/Directory.hs +23/−0
• src/Distribution/Hi/FilePath.hs +29/−0
• src/Distribution/Hi/Flag.hs +36/−0
• src/Distribution/Hi/Option.hs +52/−0
• src/Distribution/Hi/Template.hs +32/−0
• src/Distribution/Hi/Types.hs +29/−0
• src/Distribution/Hi/Version.hs +7/−0
• src/Main.hs +13/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,30 @@+Copyright (c) 2013, Fujimura Daisuke++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Fujimura Daisuke nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,124 @@+name:                hi+version:             0.0.1+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+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"+    .++    .+    will generate:+    .++    .+    > $ tree .+    > .+    > ├── LICENSE+    > ├── README.md+    > ├── foo-bar-baz.cabal+    > ├── src+    > │  └── Foo+    > │      └── Bar+    > │          ├── Baz+    > │          │  └── Internal.hs+    > │          └── Baz.hs+    > └── test+    >     ├── Foo+    >     │  └── Bar+    >     │      ├── Baz+    >     │      └── BazSpec.hs+    >     └── Spec.hs+    .++    .+    See <https://github.com/fujimura/hi> for further usage.+    .+++library+  exposed-modules:+      Distribution.Hi+      Distribution.Hi.Compiler+      Distribution.Hi.Context+      Distribution.Hi.Directory+      Distribution.Hi.FilePath+      Distribution.Hi.Flag+      Distribution.Hi.Option+      Distribution.Hi.Template+      Distribution.Hi.Types+      Distribution.Hi.Version+  ghc-options:+      -Wall+  hs-source-dirs:+      src+  build-depends:+        base       == 4.*+      , Glob+      , bytestring+      , directory+      , filepath+      , process+      , split+      , template   == 0.2.*+      , temporary+      , text+      , time++executable hi+  main-is:+      Main.hs+  ghc-options:+      -Wall+  hs-source-dirs:+      src+  build-depends:+        base       == 4.*+      , Glob+      , bytestring+      , directory+      , filepath+      , process+      , split+      , template   == 0.2.*+      , temporary+      , text+      , time++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+      , hspec       >= 1.5+      , process+      , template    == 0.2.*+      , temporary+      , text++source-repository head+  type:     git+  location: https://github.com/fujimura/hi.git

@@ -0,0 +1,27 @@+{-# LANGUAGE NamedFieldPuns #-}+module Distribution.Hi where++import           Distribution.Hi.Compiler (compile)+import           Distribution.Hi.FilePath (toDestionationPath, toDir)+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)++-- | Main function+cli :: InitFlags -> IO ()+cli initFlags@(InitFlags {moduleName, repository}) = do+    currentDirecotory <- getCurrentDirectory++    withTemplatesFromRepo (repository) $ \templates -> do++      let sourceAndDestinations = map (id &&& toDestionationPath initFlags) templates++      createDirectoryIfMissing True $ joinPath [currentDirecotory, "src",  toDir moduleName]+      createDirectoryIfMissing True $ joinPath [currentDirecotory, "test", toDir moduleName]++      forM_ sourceAndDestinations $ \(s,d) -> compile s (joinPath [currentDirecotory, d]) $ context initFlags

@@ -0,0 +1,17 @@+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

@@ -0,0 +1,21 @@+{-# 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

@@ -0,0 +1,23 @@+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

@@ -0,0 +1,29 @@+module Distribution.Hi.FilePath+    (+      toDestionationPath+    , toDir+    ) 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

@@ -0,0 +1,36 @@+{-# 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        = lookupRepository+                                  }+  where+    lookupPackageName = lookup' "packageName"+    lookupModuleName  = lookup' "moduleName"+    lookupAuthor      = lookup' "author"+    lookupEmail       = lookup' "email"+    lookupRepository  = lookup' "repository"+    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"

@@ -0,0 +1,52 @@+{-# LANGUAGE OverloadedStrings #-}++module Distribution.Hi.Option+    (+      getInitFlags+    , getMode+    ) where++import           Distribution.Hi.Flag      (extractInitFlags)+import           Distribution.Hi.Types+import           Control.Applicative+import           Data.Time.Calendar    (toGregorian)+import           Data.Time.Clock       (getCurrentTime, utctDay)+import           System.Console.GetOpt+import           System.Environment    (getArgs)++-- | 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"+    ]++-- | Returns 'InitFlags'.+getInitFlags :: IO InitFlags+getInitFlags = extractInitFlags <$> (addYear =<< fst <$> parseArgs <$> getArgs)++-- | Returns 'Mode'.+getMode :: IO Mode+getMode = do+    args <- fst <$> parseArgs <$> getArgs+    return $ if any id [True |Version <- args]+               then ShowVersion+               else Run++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...]"++addYear :: [Arg] -> IO [Arg]+addYear args = do+    (y,_,_) <- (toGregorian . utctDay) <$> getCurrentTime+    return $ (Val "year" $ show y):args

@@ -0,0 +1,32 @@+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"

@@ -0,0 +1,29 @@+{-# 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 | Val Label String deriving(Eq, Show)++-- | Run mode.+data Mode = ShowVersion | Run deriving(Eq, Show)

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

@@ -0,0 +1,13 @@+module Main where++import qualified Distribution.Hi         as Hi+import           Distribution.Hi.Option  (getInitFlags, getMode)+import           Distribution.Hi.Types+import           Distribution.Hi.Version (version)++main :: IO ()+main = do+    mode <- getMode+    case mode of+      ShowVersion -> print version+      Run         -> Hi.cli =<< getInitFlags

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}