diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,2 +1,12 @@ -# hinit +# hinit +## 0.2.0 (2020-12-24) + +* Add nix flake to the bundled haskell template +* Add `license` to context overrides +* Cut down on external dependencies (parsec, spdx) +* Implement VCS repository initialization + +## 0.1.0 (2020-12-23) + +Initial release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,5 +1,7 @@ # hinit +[![Hackage](https://img.shields.io/hackage/v/hinit.svg)](http://hackage.haskell.org/package/hinit) + `hi` is a generic project initialization tool that is written in Haskell. It is similar to cookiecutter in functionality. ## Installation @@ -128,6 +130,6 @@ `hi` will set the values for some special variables and can overwrite user configs. These names should not be used in your `options`. These special variables include: -- `name`, `email`, `github_usernmae` +- `name`, `email`, `github_usernmae`, `license` - `year`, `month`, `day`, `iso8601`: system time - `project`: the name of the project that is trying to create. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -18,7 +18,9 @@ import Hinit.Errors import Hinit.License import Hinit.Optionals +import Hinit.Process import Hinit.Template +import Hinit.Utils import Path.IO import System.IO @@ -31,6 +33,7 @@ & runError' @MustacheError simpleHandler & runError' @TemplateNotFound simpleHandler & runError' @ProjectAlreadExist simpleHandler + & runError' @ProcessExitFailure simpleHandler & runTimeC & runTerminal @@ -45,6 +48,7 @@ Has (Throw MustacheError) sig m, Has (Throw TemplateNotFound) sig m, Has (Throw ProjectAlreadExist) sig m, + Has (Throw ProcessExitFailure) sig m, Has Terminal sig m, Has Time sig m, MonadIO m @@ -75,6 +79,7 @@ ignores <- ignoredFiles ctx templateConfig let mustacheCtx = fromContext ctx initFromTemplate ignores mustacheCtx path projectPath - case license config of - Just license' -> initializeLicense license' ctx projectPath - Nothing -> pure () + whenJust (license config) $ \license' -> do + initializeLicense license' ctx projectPath + whenJust (vcs config) $ \vcs' -> do + initVCS vcs' projectPath diff --git a/data/templates/haskell/{{ project }}.cabal b/data/templates/haskell/{{ project }}.cabal --- a/data/templates/haskell/{{ project }}.cabal +++ b/data/templates/haskell/{{ project }}.cabal @@ -5,7 +5,7 @@ -- synopsis: -- description: -- category: --- license: +license: {{ license }} license-file: LICENSE author: {{ name }} maintainer: {{ name }} <{{ email }}> diff --git a/hinit.cabal b/hinit.cabal --- a/hinit.cabal +++ b/hinit.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hinit -version: 0.1.0 +version: 0.2.0 synopsis: Generic project initialization tool description: hinit is a generic project initialization tool similar to cookiecutter. @@ -34,7 +34,7 @@ common common-attrs build-depends: , base >=4.10 && <5 - , fused-effects ^>=1.1.1 + , fused-effects ^>=1.1.0 , path-io ^>=1.6.2 default-language: Haskell2010 @@ -81,12 +81,11 @@ , megaparsec ^>=9.0.0 , mustache ^>=2.3.1 , optparse-applicative >=0.15.1 && <1.17 - , parsec ^>=3.1.14 , parser-combinators ^>=1.2.1 , path >=0.7.0 && <0.9 , prettyprinter >=1.6.2 && <1.8 , prettyprinter-ansi-terminal ^>=1.1.2 - , spdx ^>=1.0.0 + , process ^>=1.6.9 , spdx-license ^>=0.1.0 , string-interpolate ^>=0.3.0 , text ^>=1.2.3 @@ -104,6 +103,7 @@ Hinit.Errors Hinit.License Hinit.Optionals + Hinit.Process Hinit.Template Hinit.Template.Config Hinit.Types diff --git a/src/Hinit/Config.hs b/src/Hinit/Config.hs --- a/src/Hinit/Config.hs +++ b/src/Hinit/Config.hs @@ -18,7 +18,7 @@ import Data.Time.LocalTime import Distribution.Parsec import Distribution.Pretty -import Distribution.SPDX.Extra +import Distribution.SPDX import GHC.Generics import Hinit.Errors import Hinit.Types @@ -137,6 +137,7 @@ ("github_username", Text ghUserName), ("project", Text project) ] + ++ maybe [] (\l -> pure ("license", Text $ pack $ prettyShow l)) license pure (M.fromList overrides, defAttrs) where show' :: Show a => a -> Text diff --git a/src/Hinit/Errors.hs b/src/Hinit/Errors.hs --- a/src/Hinit/Errors.hs +++ b/src/Hinit/Errors.hs @@ -17,13 +17,14 @@ import Data.Text.Prettyprint.Doc.Render.Terminal import Data.Void import GHC.Generics +import Hinit.Types import Hinit.Utils import Path import System.Exit import System.IO +import System.Process import Text.Megaparsec.Error import Text.Mustache.Render -import qualified Text.Parsec.Error as T import Toml.Codec.Error import Prelude hiding (print) @@ -68,7 +69,7 @@ data MustacheError = forall a. RenderingError (Path Rel a) Bool [SubstitutionError] - | forall a. TemplateParseError (Path Rel a) Bool T.ParseError + | forall a. TemplateParseError (Path Rel a) Bool Text deriving (Show) via PrettyShow MustacheError deriving anyclass (Exception) @@ -82,7 +83,7 @@ | (TemplateParseError p isFilename err) <- e = vsep [ [i|failed to parse the #{s isFilename} of file #{toFilePath p}:|], - indent 2 $ viaShow err + indent 2 $ pretty err ] where s :: Bool -> String @@ -124,10 +125,43 @@ pretty (ProjectAlreadExist a) = [i|project #{a} already exists, to overwrite it use -f/--force|] +newtype VcsCmdNotFound = VcsCmdNotFound VCS + deriving (Eq, Generic) + deriving (Show) via PrettyShow VcsCmdNotFound + deriving anyclass (Exception) + +instance Pretty VcsCmdNotFound where + pretty (VcsCmdNotFound vcs) = + [i|vcs tool #{vcs} was not installed even though it was specified in your config|] + +data ProcessExitFailure + = ProcessExitFailure CmdSpec Int String String + deriving (Eq, Generic) + deriving (Show) via PrettyShow ProcessExitFailure + deriving anyclass (Exception) + +instance Pretty ProcessExitFailure where + pretty (ProcessExitFailure cmd e out err) = + vsep + [ [i|process "#{prettyCmd cmd}" failed with exit code #{e}|], + "stdout:", + indent 2 $ pretty out, + "stderr:", + indent 2 $ pretty err + ] + where + prettyCmd (ShellCommand c) = c + prettyCmd (RawCommand c args) = unwords (c : args) + prettyPrintError :: Has Terminal sig m => Doc AnsiStyle -> m () prettyPrintError err = prettyPrint stderr doc where doc = (annotate (color Red) "Error" <> ":") <+> err + +prettyPrintWarning :: Has Terminal sig m => Doc AnsiStyle -> m () +prettyPrintWarning warning = prettyPrint stderr doc + where + doc = (annotate (color Yellow) "Warning" <> ":") <+> warning simpleHandler :: (Has Terminal sig m, Has (Lift IO) sig m, Pretty a) => a -> m () simpleHandler a = do diff --git a/src/Hinit/License.hs b/src/Hinit/License.hs --- a/src/Hinit/License.hs +++ b/src/Hinit/License.hs @@ -10,7 +10,7 @@ import Data.Text (Text) import qualified Data.Text.IO as T import Distribution.Pretty -import Distribution.SPDX.Extra hiding (License) +import Distribution.SPDX (LicenseId) import Distribution.SPDX.Template import Hinit.Types import Path diff --git a/src/Hinit/Process.hs b/src/Hinit/Process.hs new file mode 100644 --- /dev/null +++ b/src/Hinit/Process.hs @@ -0,0 +1,68 @@ +module Hinit.Process where + +import Control.Effect.Lift +import Control.Effect.Terminal +import Control.Effect.Throw +import Control.Monad +import Data.Maybe +import Data.Text.Prettyprint.Doc +import Hinit.Errors +import Hinit.Types +import Hinit.Utils +import Path +import System.Directory +import System.Exit +import System.IO (hGetContents) +import System.Process + +vcsInitProc :: VCS -> Maybe CreateProcess +vcsInitProc Git = Just $ proc "git" ["init"] +vcsInitProc Mercurial = Just $ proc "hg" ["init"] +vcsInitProc Darcs = Just $ proc "darcs" ["init"] +vcsInitProc Pijul = Just $ proc "pijul" ["init"] +vcsInitProc (Other _) = Nothing + +guessExecutableExists :: Has (Lift IO) sig m => CmdSpec -> m Bool +guessExecutableExists ShellCommand {} = pure True +guessExecutableExists (RawCommand exe _) = isJust <$> sendIO (findExecutable exe) + +initVCS :: + ( Has (Lift IO) sig m, + Has (Throw ProcessExitFailure) sig m, + Has Terminal sig m + ) => + VCS -> + Path a Dir -> + m () +initVCS vcs dir = do + whenJust (vcsInitProc vcs) $ \process -> do + exists <- guessExecutableExists $ cmdspec process + let cp = + process + { cwd = Just (toFilePath dir) + } + if not exists + then prettyPrintWarning $ pretty $ VcsCmdNotFound vcs + else runProc cp + +runProc :: + ( Has (Lift IO) sig m, + Has (Throw ProcessExitFailure) sig m + ) => + CreateProcess -> + m () +runProc cp = do + ~(_, Just stdout, Just stderr, ph) <- + sendIO $ + createProcess + cp + { std_out = CreatePipe, + std_err = CreatePipe + } + c <- sendIO $ waitForProcess ph + case c of + ExitSuccess -> pure () + ExitFailure i -> do + out <- sendIO $ hGetContents stdout + err <- sendIO $ hGetContents stderr + throwError $ ProcessExitFailure (cmdspec cp) i out err diff --git a/src/Hinit/Template.hs b/src/Hinit/Template.hs --- a/src/Hinit/Template.hs +++ b/src/Hinit/Template.hs @@ -68,7 +68,7 @@ let srcFilename = filename src let srcParentDir = parent src case compileTemplate "" (pack $ fromRelFile srcFilename) of - Left e -> throwError $ TemplateParseError src True e + Left e -> throwError $ TemplateParseError src True (pack $ show e) Right fileNameTmpl -> do let (errs, tgtFileNameRaw) = checkedSubstitute fileNameTmpl ctx unless (null errs) $ @@ -83,7 +83,7 @@ let tgtFilePath = tgtbase srcParentDir tgtFileName srcFileContent <- sendIO $ T.readFile (toFilePath srcFilePath) case compileTemplate (toFilePath src) srcFileContent of - Left e' -> throwError $ TemplateParseError src False e' + Left e' -> throwError $ TemplateParseError src False (pack $ show e') Right fileTmpl -> do let (errs', tgtFileContent) = checkedSubstitute fileTmpl ctx unless (null errs') $ @@ -111,7 +111,7 @@ let srcDirName = dirname src let srcParentDir = parent src case compileTemplate "" (pack $ fromRelDir srcDirName) of - Left e -> throwError $ TemplateParseError src True e + Left e -> throwError $ TemplateParseError src True (pack $ show e) Right fileNameTmpl -> do let (errs, tgtFileNameRaw) = checkedSubstitute fileNameTmpl ctx unless (null errs) $ diff --git a/src/Hinit/Types.hs b/src/Hinit/Types.hs --- a/src/Hinit/Types.hs +++ b/src/Hinit/Types.hs @@ -4,7 +4,7 @@ import Data.Map.Strict (Map) import Data.String.Interpolate -import Data.Text (Text) +import Data.Text (Text, unpack) import GHC.Generics import Text.Mustache import qualified Text.Mustache.Types as M @@ -62,7 +62,14 @@ | Darcs | Pijul | Other Text - deriving (Show, Eq, Generic) + deriving (Eq, Generic) + +instance Show VCS where + show Git = "git" + show Mercurial = "mercurial" + show Darcs = "darcs" + show Pijul = "pijul" + show (Other t) = unpack t vcsToT :: VCS -> Text vcsToT v = diff --git a/src/Hinit/Utils.hs b/src/Hinit/Utils.hs --- a/src/Hinit/Utils.hs +++ b/src/Hinit/Utils.hs @@ -25,3 +25,7 @@ matches :: [Pattern] -> FilePath -> Bool matches ps fp = or $ fmap (`match` fp) ps + +whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m () +whenJust Nothing _ = pure () +whenJust (Just a) k = k a