hinit 0.1.0 → 0.2.0
raw patch · 12 files changed
+151/−20 lines, 12 filesdep +processdep −parsecdep −spdx
Dependencies added: process
Dependencies removed: parsec, spdx
Files
- CHANGELOG.md +11/−1
- README.md +3/−1
- app/Main.hs +8/−3
- data/templates/haskell/{{ project }}.cabal +1/−1
- hinit.cabal +4/−4
- src/Hinit/Config.hs +2/−1
- src/Hinit/Errors.hs +37/−3
- src/Hinit/License.hs +1/−1
- src/Hinit/Process.hs +68/−0
- src/Hinit/Template.hs +3/−3
- src/Hinit/Types.hs +9/−2
- src/Hinit/Utils.hs +4/−0
CHANGELOG.md view
@@ -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
README.md view
@@ -1,5 +1,7 @@ # hinit +[](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.
app/Main.hs view
@@ -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
data/templates/haskell/{{ project }}.cabal view
@@ -5,7 +5,7 @@ -- synopsis: -- description: -- category:--- license:+license: {{ license }} license-file: LICENSE author: {{ name }} maintainer: {{ name }} <{{ email }}>
hinit.cabal view
@@ -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
src/Hinit/Config.hs view
@@ -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
src/Hinit/Errors.hs view
@@ -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
src/Hinit/License.hs view
@@ -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
+ src/Hinit/Process.hs view
@@ -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
src/Hinit/Template.hs view
@@ -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) $
src/Hinit/Types.hs view
@@ -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 =
src/Hinit/Utils.hs view
@@ -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