hi 1.2.0.0 → 1.2.0.1
raw patch · 5 files changed
+534/−99 lines, 5 filesdep ~basedep ~doctestdep ~temporary
Dependency ranges changed: base, doctest, temporary
Files
- hi.cabal +162/−99
- test/FeatureSpec.hs +217/−0
- test/Hi/GitSpec.hs +18/−0
- test/HiSpec.hs +94/−0
- test/SpecHelper.hs +43/−0
hi.cabal view
@@ -1,68 +1,70 @@-name: hi-version: 1.2.0.0-cabal-version: >=1.8-build-type: Simple-license: BSD3-license-file: LICENSE-maintainer: me@fujimuradaisuke.com-homepage: https://github.com/fujimura/hi-bug-reports: https://github.com/fujimura/hi/issues-synopsis: Generate scaffold for cabal project-description:- This application generates a scaffold for Haskell project from a Git repository.- .- This command- .- .- > $ hi foo-bar-baz- .- .- 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.- .-category: Distribution-author: Fujimura Daisuke- +-- This file has been generated from package.yaml by hpack version 0.13.0.+--+-- see: https://github.com/sol/hpack++name: hi+version: 1.2.0.1+cabal-version: >= 1.10+build-type: Simple+license: BSD3+license-file: LICENSE+maintainer: me@fujimuradaisuke.com+homepage: https://github.com/fujimura/hi.git#readme+bug-reports: https://github.com/fujimura/hi.git/issues+synopsis: Generate scaffold for cabal project+description: This application generates a scaffold for Haskell project from a Git repository.+ .+ This command+ .+ .+ > $ hi foo-bar-baz+ .+ .+ 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.+category: Distribution+author: Fujimura Daisuke+ source-repository head type: git location: https://github.com/fujimura/hi.git- + library build-depends: base ==4.*,- ansi-wl-pprint -any,- bytestring -any,- directory -any,- filepath -any,+ ansi-wl-pprint,+ bytestring,+ directory,+ filepath, optparse-applicative >=0.10.0,- parsec -any,- process >=1.2.0.0,- split -any,+ parsec,+ split, template ==0.2.*,- temporary >=1.2.0.3, text >1.0,- time -any+ time,+ process >=1.2.0.0,+ temporary >=1.2.0.3 exposed-modules: Hi Hi.Cli@@ -74,65 +76,126 @@ Hi.CommandLineOption Hi.Template Hi.Types- exposed: True- buildable: True- hs-source-dirs: src+ hs-source-dirs:+ src other-modules:+ Main Paths_hi+ default-language: Haskell2010 ghc-options: -Wall- + executable hi build-depends: base ==4.*,- ansi-wl-pprint -any,- bytestring -any,- directory -any,- filepath -any,+ ansi-wl-pprint,+ bytestring,+ directory,+ filepath, optparse-applicative >=0.10.0,- parsec -any,- process >=1.2.0.0,- split -any,+ parsec,+ split, template ==0.2.*,- temporary ==1.2.0.3, text >1.0,- time -any+ time,+ process >=1.2.0.0,+ temporary >=1.2.0.3+ other-modules:+ Hi+ Hi.Cli+ Hi.CommandLineOption+ Hi.Config+ Hi.Directory+ Hi.FilePath+ Hi.Git+ Hi.Option+ Hi.Template+ Hi.Types+ default-language: Haskell2010 main-is: Main.hs- buildable: True- hs-source-dirs: src+ hs-source-dirs:+ src ghc-options: -Wall- ++test-suite doctests+ build-depends:+ base ==4.*,+ ansi-wl-pprint,+ bytestring,+ directory,+ filepath,+ optparse-applicative >=0.10.0,+ parsec,+ split,+ template ==0.2.*,+ text >1.0,+ time,+ base,+ doctest >=0.8,+ process+ other-modules:+ Hi+ Hi.Cli+ Hi.CommandLineOption+ Hi.Config+ Hi.Directory+ Hi.FilePath+ Hi.Git+ Hi.Option+ Hi.Template+ Hi.Types+ Main+ FeatureSpec+ Hi.GitSpec+ HiSpec+ Spec+ SpecHelper+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: doctests.hs+ hs-source-dirs:+ src,+ test+ ghc-options: -Wall -threaded+ test-suite spec build-depends:- base -any,- ansi-wl-pprint -any,- HUnit -any,- bytestring -any,- directory -any,- doctest -any,- filepath -any,- hspec >=2.0.0,+ base ==4.*,+ ansi-wl-pprint,+ bytestring,+ directory,+ filepath, optparse-applicative >=0.10.0,- parsec -any,- process -any,- silently -any,- split -any,+ parsec,+ split, template ==0.2.*,- temporary ==1.2.0.3, text >1.0,- time -any+ time,+ HUnit,+ doctest,+ hspec >=2.0.0,+ process,+ silently,+ temporary >=1.2.0.3+ other-modules:+ Hi+ Hi.Cli+ Hi.CommandLineOption+ Hi.Config+ Hi.Directory+ Hi.FilePath+ Hi.Git+ Hi.Option+ Hi.Template+ Hi.Types+ Main+ FeatureSpec+ Hi.GitSpec+ HiSpec+ SpecHelper+ default-language: Haskell2010 type: exitcode-stdio-1.0 main-is: Spec.hs- buildable: True- hs-source-dirs: src test+ hs-source-dirs:+ src,+ test ghc-options: -Wall-test-suite doctests- build-depends:- base -any,- doctest >=0.8,- process -any- type: exitcode-stdio-1.0- main-is: doctests.hs- buildable: True- hs-source-dirs: src test- ghc-options: -threaded-
+ test/FeatureSpec.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE ScopedTypeVariables #-}++module FeatureSpec where++import qualified Hi.Cli as Cli+import Hi.Directory (inDirectory)++import Control.Applicative+import Control.Exception (catch, throwIO)+import Data.Time.Calendar (toGregorian)+import Data.Time.Clock (getCurrentTime, utctDay)+import Data.Version (showVersion)+import SpecHelper+import System.Directory (doesDirectoryExist, doesFileExist,+ getCurrentDirectory)+import System.Exit (ExitCode (..))+import System.FilePath (joinPath, (</>))+import System.IO (stdout)+import System.IO.Silently (capture, hSilence)+import System.Process (readProcess, system)+import Test.Hspec++import Paths_hi (version)++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "with command line options" $ do+ let cmd = runWithCommandLineOptions [ "-p", packageName , "-m", moduleName ]+ around_ cmd features++ describe "with custom git config" $ do+ let cmd = runWithLocalGitConfig [ "-p", packageName , "-m", moduleName ]+ around_ cmd features++ describe "with config file" $ do+ let cmd = runWithConfigurationFile [ "-p", packageName , "-m", moduleName ]+ around_ cmd features++ describe "Only package name was given" $ do+ let cmd = runWithCommandLineOptions ["-p", "something-weird"]++ around_ cmd $ do+ it "should use Capitalized package name as module name" $ do+ doesDirectoryExist "something-weird/src/Something/Weird" `shouldReturn` True++ describe "Package name was given as an argument" $ do+ let cmd = runWithCommandLineOptions ["something-weird"]++ around_ cmd $ do+ it "should use Capitalized package name as module name" $ do+ doesDirectoryExist "something-weird/src/Something/Weird" `shouldReturn` True++ describe "Directory name was given" $ do+ let cmd = runWithCommandLineOptions ["abc", "-d", "efg"]++ around_ cmd $ do+ it "should create file in given directory" $ do+ doesDirectoryExist "efg/src/Abc" `shouldReturn` True++ -- https://github.com/fujimura/hi/issues/48+ describe "with --module-name, not --moduleName" $ do+ let cmd = runWithConfigurationFile [ "-p", packageName , "--module-name", moduleName ]+ around_ cmd features++ describe "with --initialize-git-repository" $ do+ let cmd = runWithCommandLineOptions [ "--initialize-git-repository"+ , "-p"+ , packageName+ , "-m"+ , moduleName ]+ around_ cmd $ do+ it "should initialize it as git repository and make first commit" $ do+ inDirectory "./testapp" $ do+ readProcess "git" ["log", "-1", "--pretty=%s"] [] `shouldReturn` "Initial commit\n"++ describe "with --after-command='cabal sandbox init'" $ do+ let cmd = runWithCommandLineOptions [ "--after-command"+ , "cabal sandbox init"+ , "-p"+ , packageName+ ]+ around_ cmd $ do+ it "should initialize it as git repository and make first commit" $ do+ doesFileExist "testapp/cabal.sandbox.config" `shouldReturn` True++ describe "-v" $ do+ it "should show version number" $ do+ let handle ExitSuccess = return ()+ handle e = throwIO e++ (res,_) <- capture $ Cli.run ["-v"] `catch` handle+ res `shouldBe` (showVersion version) ++ "\n"++packageName, moduleName, author, email :: String+packageName = "testapp"+moduleName = "System.Awesome.Library"+author = "Fujimura Daisuke"+email = "me@fujimuradaisuke.com"++features :: Spec+features = do++ describe "LICENSE" $ do+ it "should include author" $ do+ compiled <- readFile "testapp/LICENSE"+ compiled `shouldContain` "Fujimura Daisuke"++ it "should include year" $ do+ (year,_,_) <- (toGregorian . utctDay) <$> getCurrentTime+ compiled <- readFile "testapp/LICENSE"+ compiled `shouldContain` show year++ describe "README.md" $ do+ it "should include name" $ do+ compiled <- readFile "testapp/README.md"+ compiled `shouldContain` "testapp"++ describe "module-name.cabal" $ do+ it "should include name" $ do+ compiled <- readFile "testapp/testapp.cabal"+ compiled `shouldContain` "testapp"++ it "should include author" $ do+ compiled <- readFile "testapp/testapp.cabal"+ compiled `shouldContain` "Fujimura Daisuke"++ it "should include email" $ do+ compiled <- readFile "testapp/testapp.cabal"+ compiled `shouldContain` "me@fujimuradaisuke.com"++ it "should include exposed-modules" $ do+ compiled <- readFile "testapp/testapp.cabal"+ compiled `shouldContain` "Exposed-Modules: System.Awesome.Library"++ it "should include other-modules" $ do+ compiled <- readFile "testapp/testapp.cabal"+ compiled `shouldContain` "Other-Modules: System.Awesome.Library.Internal"++ describe "directory" $ do+ it "should be made according to given module name" $ do+ doesDirectoryExist "testapp/src/System/Awesome/Library" `shouldReturn` True++ describe "Main module" $ do+ it "should be made" $ do+ doesFileExist "testapp/src/System/Awesome/Library.hs" `shouldReturn` True++ it "should include proper module name" $ do+ compiled <- readFile "testapp/src/System/Awesome/Library.hs"+ compiled `shouldContain` "module System.Awesome.Library"++ describe "Internal module" $ do+ it "should be made" $ do+ doesFileExist "testapp/src/System/Awesome/Library/Internal.hs" `shouldReturn` True++ it "should include proper module name" $ do+ compiled <- readFile "testapp/src/System/Awesome/Library/Internal.hs"+ compiled `shouldContain` "module System.Awesome.Library.Internal"++ describe "Spec.hs" $ do+ it "should be made" $ do+ doesFileExist "testapp/test/Spec.hs" `shouldReturn` True++ it "should include proper content" $ do+ compiled <- readFile "testapp/test/Spec.hs"+ compiled `shouldContain` "{-# OPTIONS_GHC -F -pgmF hspec-discover #-}"++ describe "Main spec" $ do+ it "should be made" $ do+ doesFileExist "testapp/test/System/Awesome/LibrarySpec.hs" `shouldReturn` True++ it "should include proper content" $ do+ compiled <- readFile "testapp/test/System/Awesome/LibrarySpec.hs"+ compiled `shouldContain` "module System.Awesome.LibrarySpec (main, spec) where"++ describe ".gitignore" $ do+ it "should be made" $ do+ doesFileExist "testapp/.gitignore" `shouldReturn` True++runWithCommandLineOptions :: [String] -> IO () -> IO ()+runWithCommandLineOptions opts action = do+ root <- getCurrentDirectory+ inTestDirectory $ hSilence [stdout] $ do+ Cli.run $ opts ++ [ "-a", quote author+ , "-e", quote email+ , "-r", (root </> "test" </> "template")+ ]+ action++runWithLocalGitConfig :: [String] -> IO () -> IO ()+runWithLocalGitConfig opts action = do+ root <- getCurrentDirectory+ inTestDirectory $ hSilence [stdout] $ do+ _ <- system $ "git init"+ _ <- system $ "git config user.name" ++ " " ++ quote author+ _ <- system $ "git config user.email" ++ " " ++ quote email+ Cli.run $ opts ++ [ "-r", (root </> "test" </> "template") ]+ action++runWithConfigurationFile :: [String] -> IO () -> IO ()+runWithConfigurationFile opts action = do+ root <- getCurrentDirectory+ inTestDirectory $ hSilence [stdout] $ do+ writeFile ".hirc" $ concatLines+ [ "author: " ++ author+ , "email: " ++ email+ ]+ pwd' <- getCurrentDirectory+ withEnv "HOME" pwd' $ do+ Cli.run $ opts ++ [ "--configuration-file", (joinPath [pwd', ".hirc"])+ , "-r", (root </> "test" </> "template")+ ]+ action++{-# ANN module "HLint: Redundant do" #-}
+ test/Hi/GitSpec.hs view
@@ -0,0 +1,18 @@+module Hi.GitSpec ( main, spec ) where++import Hi.Git++import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ let fullUrl = "git@github.com:fujimura/hi.git"+ shortUrl = "gh:fujimura/hi"+ describe "Hi.Git.expandUrl" $ do+ it "should do nothing with full git url" $ do+ expandUrl fullUrl `shouldBe` fullUrl+ it "should expand `gh:fujimura/hi` to `git@github.com:fujimura/hi.git`" $ do+ expandUrl shortUrl `shouldBe` fullUrl
+ test/HiSpec.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings #-}++module HiSpec ( main, spec ) where++import Hi (process)+import Hi.Types++import Data.ByteString.Char8 (unpack)+import Data.Maybe (fromJust, isJust)+import Test.Hspec++main :: IO ()+main = hspec spec++options :: Option+options = Option { packageName = "testapp"+ , moduleName = "System.Awesome.Library"+ , directoryName = "testapp"+ , author = "Fujimura Daisuke"+ , email = "me@fujimuradaisuke.com"+ , templateSource = FromRepo "file://somewhere"+ , year = "2014"+ , afterCommands = []+ }++lookupContent :: FilePath -> Files -> Maybe String+lookupContent _ [] = Nothing+lookupContent fp (f:fs) = if getFilePath f == fp+ then Just $ stringifyContents f+ else lookupContent fp fs++stringifyContents :: File -> String+stringifyContents = unpack . getFileContents++spec :: Spec+spec =+ describe "Hi.process" $ do+ context "Option `packageName` was given and it's in the template" $+ it "should be replaced with the value" $+ let files = process options [TemplateFile "package-name/dummy.template" "Foo $packageName bar, \n"] in+ fromJust (lookupContent "testapp/dummy" files) `shouldContain` packageName options++ context "Option `moduleName` was given and it's in the template" $+ it "should be replaced with the value" $+ let files = process options [TemplateFile "package-name/dummy.template" "Foo $moduleName bar, \n"] in+ fromJust (lookupContent "testapp/dummy" files) `shouldContain` moduleName options++ context "Option `author` was given and it's in the template" $+ it "should be replaced with the value" $+ let files = process options [TemplateFile "package-name/dummy.template" "Foo $author bar, \n"] in+ fromJust (lookupContent "testapp/dummy" files) `shouldContain` author options++ context "Option `email` was given and it's in the template" $+ it "should be replaced with the value" $+ let files = process options [TemplateFile "package-name/dummy.template" "Foo $email bar, \n"] in+ fromJust (lookupContent "testapp/dummy" files) `shouldContain` email options++ context "`ModuleName` was given and `moduleName` is in the file path" $+ it "should be replaced with given value, replacing period with path separator" $+ let files = process (options { moduleName = "Bar"}) [TemplateFile "package-name/foo/ModuleName/File.hs.template" "module Foo\n"] in+ lookupContent "testapp/foo/Bar/File.hs" files `shouldSatisfy` isJust++ context "`/package-name` exists in template" $+ it "should generate files in package-name, not in package-name/package-name" $ do+ let files = process (options {packageName = "foo", moduleName = "Foo", directoryName = "baz"})+ [TemplateFile "package-name/ModuleName/File.hs.template" "module Foo\n" ]++ lookupContent "baz/Foo/File.hs" files `shouldBe` Just "module Foo\n"++ describe "file without .template" $+ it "should be copied without substitution" $+ let files = process (options {moduleName = "Bar"}) [RegularFile "package-name/ModuleName/Foofile" "foo: $bar\n"] in+ lookupContent "testapp/Bar/Foofile" files `shouldBe` Just "foo: $bar\n"++ describe "Regular file and template file with same name" $+ it "should be copied without substitution" $+ let files = process (options {moduleName = "Bar"}) [RegularFile "package-name/Foofile" "foo: r\n", TemplateFile "package-name/Foofile" "foo: t\n"] in+ files `shouldBe` [TemplateFile "testapp/Foofile" "foo: t\n"]++ describe "Files in root directory" $+ it "should be copied" $+ let files = process (options {moduleName = "Bar"}) [RegularFile "Foofile" "foo: r\n", TemplateFile "package-name/Foofile" "foo: t\n"] in+ files `shouldBe` [TemplateFile "testapp/Foofile" "foo: t\n"]++ describe "Unknown variable in template" $+ it "should not be substituted" $+ let files = process (options {moduleName = "Bar"}) [TemplateFile "package-name/Foofile" "foo: $unknown\n"] in+ files `shouldBe` [TemplateFile "testapp/Foofile" "foo: $unknown\n"]++ describe "Directory name was specified" $+ it "should use it" $+ let files = process (options {moduleName = "Bar", directoryName = "baz"})+ [TemplateFile "package-name/ModuleName/Foofile" "foo: x\n"] in+ files `shouldBe` [TemplateFile "baz/Bar/Foofile" "foo: x\n"]
+ test/SpecHelper.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}++module SpecHelper where++import Control.Exception (bracket_, bracket)+import Data.List (intercalate)+import System.Directory (createDirectoryIfMissing,+ getCurrentDirectory,+ removeDirectoryRecursive,+ setCurrentDirectory)+import System.Environment (setEnv, lookupEnv, unsetEnv)++concatLines :: [String] -> String+concatLines = intercalate "\n"++withEnv :: String -> String -> IO a -> IO a+withEnv k v action = do+ bracket setup teardown (const action)+ where+ setup :: IO (Maybe String)+ setup = do+ mv <- lookupEnv k+ setEnv k v+ return mv+ teardown :: Maybe String -> IO ()+ teardown (Just _v) = setEnv k _v >> return ()+ teardown Nothing = unsetEnv k >> return ()++inTestDirectory :: IO () -> IO ()+inTestDirectory action = do+ pwd <- getCurrentDirectory+ let go = createDirectoryIfMissing True testDirectory >> setCurrentDirectory testDirectory+ flush = removeDirectoryRecursive testDirectory+ back = setCurrentDirectory pwd+ bracket_ go (back >> flush) action++testDirectory :: String+testDirectory = "test_project"++quote :: String -> String+quote s = "\"" ++ s ++ "\""++{-# ANN module "HLint: Redundant do" #-}