project-forge (empty) → 0.1.0.0
raw patch · 15 files changed
+955/−0 lines, 15 filesdep +Blammodep +aesondep +base
Dependencies added: Blammo, aeson, base, bytestring, containers, directory, filepath, pretty-simple, project-forge, stache, tasty, tasty-hunit, temporary, text, typed-process
Files
- CHANGELOG.md +5/−0
- README.md +21/−0
- examples/GitRepo/Example.hs +89/−0
- examples/Main.hs +10/−0
- examples/SingleDirectory/Example.hs +77/−0
- examples/SingleFile/Example.hs +76/−0
- project-forge.cabal +58/−0
- src/ProjectForge.hs +22/−0
- src/ProjectForge/Actions.hs +62/−0
- src/ProjectForge/Compile.hs +106/−0
- src/ProjectForge/Get.hs +185/−0
- src/ProjectForge/Get/Git.hs +71/−0
- src/ProjectForge/ProjectTemplate.hs +31/−0
- src/ProjectForge/Reexports.hs +12/−0
- src/ProjectForge/Render.hs +130/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for project-forge++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ README.md view
@@ -0,0 +1,21 @@+# `project-forge`: A Haskell library for forging new projects++The `project-forge` library is basically an extension of the+[`stache`](https://hackage.haskell.org/package/stache)+library with added features:++* ability to include variables in file and directory names+* utilities to get templates from a local directory+* utilities for creating project initialization CLI applications+* logging (via [`blammo`](https://hackage.haskell.org/package/Blammo))++## Features not yet implemented++* utilities to get templates from remote repositories+* ability to run pre/post scripts or `IO ()` actions++## Related Projects++* [`hinit`](https://hackage.haskell.org/package/hinit)+* [`project-template`](https://hackage.haskell.org/package/project-template)+* [`cookiecutter`](https://cookiecutter.readthedocs.io/en/stable/)
+ examples/GitRepo/Example.hs view
@@ -0,0 +1,89 @@+{-|+An example of using project-forge on a git repo++-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module GitRepo.Example where++import Control.Exception+import Data.Aeson+import ProjectForge+import System.FilePath+import Test.Tasty+import Test.Tasty.HUnit++exampleTemplate :: (MonadLogger m, MonadIO m ) => m ProjectTemplate+exampleTemplate =+ getProjectTemplateFromGit+ Nothing+ "https://test:hLdWVML8yDFyNiN4KaPN@gitlab.com/TargetRWE/epistats/nsstat/project-forge-example.git"+ Nothing++varsComplete :: Value+varsComplete = object+ [ "prj" .= String "Some Project"+ , "desc" .= String "This is a description on some project"+ , "srcDir" .= String "src"+ ]++varsIncomplete :: Value+varsIncomplete = object+ [ "prj" .= String "Some Project"+ ]++-- remove directory for these test since the directory is temporary+fn :: (FilePath, b) -> (FilePath, b)+fn (x, y) = (takeFileName x, y)++runExample1 :: Value -> IO [(FilePath, Text)]+runExample1 v =+ fmap fn <$>+ runSimpleLoggingT+ ( exampleTemplate >>= (\x -> renderProjectTemplate (MkRenderTemplateOpts WarningAsError) x v))+++runExample2 :: Value -> IO [(FilePath, Text)]+runExample2 v =+ fmap fn <$>+ runSimpleLoggingT+ (exampleTemplate >>= (\x -> renderProjectTemplate (MkRenderTemplateOpts Ignore) x v))++catchRunExample :: Value -> IO (Maybe [(FilePath, Text)])+catchRunExample v = do+ catch+ ( Just <$> runSimpleLoggingT+ (exampleTemplate >>= (\x -> renderProjectTemplate (MkRenderTemplateOpts WarningAsError) x v)))+ (\(e :: SomeException) -> pure Nothing )++exampleSuccess1 :: IO TestTree+exampleSuccess1 = testCase "Render should succeed with complete variables" .+ assertEqual "results should be equal"+ [ (".gitignore","# your basic .gitignore\n\n.RData")+ , ("README.md", "# This is the Some Project project\n\nHere you can read more about it: \n\nThis is a description on some project\n")+ , ("no-template-variables.R","# An example of a file without template variables\n\n\"this file is copied as-is\"")+ , ("project.R", "# This is the source code for Some Project\n\nprint_prj <- function() {\n print(\"Some Project\")\n}")+ ]+ <$> runExample1 varsComplete++exampleSuccess2 :: IO TestTree+exampleSuccess2 = testCase "Render should succeed with incomplete variables when ignoring errors" .+ assertEqual "results should be equal"+ [ (".gitignore","# your basic .gitignore\n\n.RData")+ , ("README.md","# This is the Some Project project\n\nHere you can read more about it: \n\n\n")+ , ("no-template-variables.R","# An example of a file without template variables\n\n\"this file is copied as-is\"")+ , ("project.R", "# This is the source code for Some Project\n\nprint_prj <- function() {\n print(\"Some Project\")\n}")+ ]+ <$> runExample2 varsIncomplete++exampleFailed :: IO TestTree+exampleFailed = testCase "Render should fail with incomplete variables" <$> (do+ results <- catchRunExample varsIncomplete+ case results of+ Nothing -> pure $ assertBool "Successfully failed" True+ Just _ -> assertFailure "This test *should* fail"+ )++examples :: IO TestTree+examples = testGroup "SimpleFile examples" <$> sequenceA [exampleSuccess1, exampleSuccess2, exampleFailed]
+ examples/Main.hs view
@@ -0,0 +1,10 @@+module Main where++import Test.Tasty++import GitRepo.Example as G (examples)+import SingleDirectory.Example as D (examples)+import SingleFile.Example as S (examples)++main :: IO ()+main = defaultMain <$> testGroup "Project Forge examples" =<< sequenceA [G.examples, S.examples, D.examples]
+ examples/SingleDirectory/Example.hs view
@@ -0,0 +1,77 @@+{-|+An example of using project-forge on a directory.++-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module SingleDirectory.Example where++import Control.Exception+import Data.Aeson+import ProjectForge+import Test.Tasty+import Test.Tasty.HUnit++exampleTemplate :: (MonadLogger m, MonadIO m ) => m ProjectTemplate+exampleTemplate = getProjectTemplateFromDir "examples/SingleDirectory/project-template/"++varsComplete :: Value+varsComplete = object+ [ "prj" .= String "Some Project"+ , "desc" .= String "This is a description on some project"+ , "srcDir" .= String "src"+ ]++varsIncomplete :: Value+varsIncomplete = object+ [ "prj" .= String "Some Project"+ ]++runExample1 :: Value -> IO [(FilePath, Text)]+runExample1 v =+ runSimpleLoggingT+ (exampleTemplate >>= (\x -> renderProjectTemplate (MkRenderTemplateOpts WarningAsError) x v))++runExample2 :: Value -> IO [(FilePath, Text)]+runExample2 v =+ runSimpleLoggingT+ (exampleTemplate >>= (\x -> renderProjectTemplate (MkRenderTemplateOpts Ignore) x v))++catchRunExample :: Value -> IO (Maybe [(FilePath, Text)])+catchRunExample v = do+ catch+ ( Just <$> runSimpleLoggingT+ (exampleTemplate >>= (\x -> renderProjectTemplate (MkRenderTemplateOpts WarningAsError) x v)))+ (\(e :: SomeException) -> pure Nothing )++exampleSuccess1 :: IO TestTree+exampleSuccess1 = testCase "Render should succeed with complete variables" .+ assertEqual "results should be equal"+ [ ("examples/SingleDirectory/project-template/.gitignore","# your basic .gitignore\n\n.RData")+ , ("examples/SingleDirectory/project-template/README.md", "# This is the Some Project project\n\nHere you can read more about it: \n\nThis is a description on some project\n")+ , ("examples/SingleDirectory/project-template/src/no-template-variables.R","# An example of a file without template variables\n\n\"this file is copied as-is\"")+ , ("examples/SingleDirectory/project-template/src/project.R", "# This is the source code for Some Project\n\nprint_prj <- function() {\n print(\"Some Project\")\n}")+ ]+ <$> runExample1 varsComplete++exampleSuccess2 :: IO TestTree+exampleSuccess2 = testCase "Render should succeed with incomplete variables when ignoring errors" .+ assertEqual "results should be equal"+ [ ("examples/SingleDirectory/project-template/.gitignore","# your basic .gitignore\n\n.RData")+ , ("examples/SingleDirectory/project-template/README.md","# This is the Some Project project\n\nHere you can read more about it: \n\n\n")+ , ("examples/SingleDirectory/project-template//no-template-variables.R","# An example of a file without template variables\n\n\"this file is copied as-is\"")+ , ("examples/SingleDirectory/project-template//project.R", "# This is the source code for Some Project\n\nprint_prj <- function() {\n print(\"Some Project\")\n}")+ ]+ <$> runExample2 varsIncomplete++exampleFailed :: IO TestTree+exampleFailed = testCase "Render should fail with incomplete variables" <$> (do+ results <- catchRunExample varsIncomplete+ case results of+ Nothing -> pure $ assertBool "Successfully failed" True+ Just _ -> assertFailure "This test *should* fail"+ )++examples :: IO TestTree+examples = testGroup "SimpleFile examples" <$> sequenceA [exampleSuccess1, exampleSuccess2, exampleFailed]
+ examples/SingleFile/Example.hs view
@@ -0,0 +1,76 @@+{-|+An example of using project-forge on a single .mustache file.++-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module SingleFile.Example where++import Control.Exception+import Data.Aeson+import ProjectForge+import Test.Tasty+import Test.Tasty.HUnit++exampleTemplate :: (MonadLogger m, MonadIO m ) => m FileTemplate+exampleTemplate = getFileTemplateFromFile "examples/SingleFile/{{name}}-report.md"++varsComplete :: Value+varsComplete = object+ [ "name" .= String "Chris"+ , "value" .= Number 10000+ , "taxed_value" .= Number 6000.0+ , "in_ca" .= True+ ]++varsIncomplete :: Value+varsIncomplete = object+ [ "name" .= String "Chris"+ , "value" .= Number 10000+ , "in_ca" .= True+ ]++runExample1 :: Value -> IO (FilePath, Text)+runExample1 v =+ runSimpleLoggingT+ (exampleTemplate >>= (\x -> renderFileTemplate (MkRenderTemplateOpts WarningAsError) x v))++runExample2 :: Value -> IO (FilePath, Text)+runExample2 v =+ runSimpleLoggingT+ (exampleTemplate >>= (\x -> renderFileTemplate (MkRenderTemplateOpts Ignore) x v))++catchRunExample :: Value -> IO (Maybe (FilePath, Text))+catchRunExample v = do+ catch+ ( Just <$> runSimpleLoggingT+ (exampleTemplate >>= (\x -> renderFileTemplate (MkRenderTemplateOpts WarningAsError) x v)))+ (\(e :: SomeException) -> pure Nothing )++exampleSuccess1 :: IO TestTree+exampleSuccess1 = testCase "Render should succeed with complete variables" <$>+ (assertEqual "results should be equal" <$>+ runExample1 varsComplete <*>+ pure ( "examples/SingleFile/Chris-report.md"+ , "Hello Chris\nYou have just won 10000 dollars!\nWell, 6000 dollars, after taxes.\n"))++exampleSuccess2 :: IO TestTree+exampleSuccess2 = testCase "Render should succeed with incomplete variables when ignoring errors" <$>+ (assertEqual "results should be equal" <$>+ runExample2 varsIncomplete <*>+ pure ( "examples/SingleFile/Chris-report.md"+ , "Hello Chris\nYou have just won 10000 dollars!\nWell, dollars, after taxes.\n"))++exampleFailed :: IO TestTree+exampleFailed = testCase "Render should fail with incomplete variables" <$> (do+ results <- catchRunExample varsIncomplete+ case results of+ Nothing -> pure $ assertBool "Successfully failed" True+ Just _ -> assertFailure "This test *should* fail"+ )++examples :: IO TestTree+examples =+ testGroup "SimpleFile examples" <$>+ sequenceA [exampleSuccess1, exampleSuccess2, exampleFailed]
+ project-forge.cabal view
@@ -0,0 +1,58 @@+cabal-version: 2.4+name: project-forge+version: 0.1.0.0+author: Bradley Saul+maintainer: bsaul@novisci.com+category: Development+extra-source-files: + CHANGELOG.md+ README.md+synopsis: A project initialization library+description: + A project initialization library based on stache. + See the project's README for more information.+license: BSD-3-Clause++library+ exposed-modules: + ProjectForge+ ProjectForge.Actions+ ProjectForge.Compile+ ProjectForge.Get+ ProjectForge.Get.Git+ ProjectForge.Render+ ProjectForge.ProjectTemplate+ ProjectForge.Reexports+ build-depends: + base >=4.16 && < 5 + , aeson+ , Blammo+ , bytestring+ , containers+ , directory+ , filepath + , stache+ , pretty-simple+ , temporary+ , text+ , typed-process+ hs-source-dirs: src+ default-language: Haskell2010++test-suite examples + type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ GitRepo.Example+ SingleFile.Example+ SingleDirectory.Example+ hs-source-dirs: examples+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base+ , aeson+ , filepath+ , tasty+ , tasty-hunit+ , project-forge+ default-language: Haskell2010
+ src/ProjectForge.hs view
@@ -0,0 +1,22 @@+{-|+The main module for ProjectForge+-}++module ProjectForge (+ module ProjectForge.Actions+ , module ProjectForge.Compile+ , module ProjectForge.Get+ , module ProjectForge.Render+ , module ProjectForge.ProjectTemplate+ , module ProjectForge.Reexports+) where++import ProjectForge.Actions+import ProjectForge.Compile+import ProjectForge.Get+import ProjectForge.ProjectTemplate+import ProjectForge.Reexports+import ProjectForge.Render+++
+ src/ProjectForge/Actions.hs view
@@ -0,0 +1,62 @@+{-|+Functions for creating project initialization applications+-}++{-# LANGUAGE OverloadedStrings #-}+module ProjectForge.Actions (+ createProjectTemplateAction+ , defaultTemplateActionOpts+) where++import Blammo.Logging.Simple+import Control.Monad.IO.Class+import Data.Aeson+import Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL+import ProjectForge.Get+import ProjectForge.Render+import System.Directory+import System.FilePath++{-|+Options for compiling, rendering and writing a a @'ProjectTemplate'@.+-}+newtype TemplateActionOpts = MkTemplateActionOpts {+ -- | The @'RenderTemplateOpts'@ for the action+ renderOpts :: RenderTemplateOpts+ }++-- | Default options+defaultTemplateActionOpts :: TemplateActionOpts+defaultTemplateActionOpts = MkTemplateActionOpts { renderOpts = defaultRenderTemplateOpts}++{-|+Create an @IO@ action that compiles, renders, and writes a @'ProjectTemplate'@.+-}+createProjectTemplateAction :: (MonadLogger m, MonadIO m, ToJSON a) =>+ TemplateActionOpts+ -> FilePath -- ^ name of directory containing project template+ -> a -- ^ type which when converted via @'Data.Aeson.toJSON'@ contains values+ -- to interpolate into the @'ProjectTemplate'@.+ -> m ()+createProjectTemplateAction opts d settings = do+ let template = getProjectTemplateFromDir d+ values = toJSON settings++ results <- (\x -> renderProjectTemplate (renderOpts opts) x values) =<< template++ writeTemplateResult results++{-+Utility for writing the results for @'renderProjectTemplate'@ to files.+-}+writeTemplateResult :: (MonadLogger m, MonadIO m) => [(FilePath, TL.Text)] -> m ()+writeTemplateResult =+ mapM_ (\(fn, cnts) -> do+ liftIO $ createDirectoryIfMissing True (takeDirectory fn)++ logDebug $ "Writing template result to file" :# [ "path" .= fn ]+ liftIO $ TL.writeFile fn cnts+ )++
+ src/ProjectForge/Compile.hs view
@@ -0,0 +1,106 @@+{-|+Functions for compiling Project and File Templates+-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+module ProjectForge.Compile (+ -- * Compiling project templates+ -- $compileTemplates+ compileFileTemplate+ , compileProjectTemplate++ -- ** Re-exports+ , module Text.Mustache.Type+) where++import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Data.Bifunctor+import qualified Data.Set as Set+import Data.Text+import ProjectForge.ProjectTemplate+import Text.Mustache.Compile+import Text.Mustache.Type+++{- $compileTemplates++Template compilation marshals @Data.Text.Text@ into @'Text.Mustache.Template'@s.+The utilities here extend the utilities provided by @Text.Mustache@+to create @'FileTemplate'@s and @'ProjectTemplate'@s.+-}++{-|+Create a @'FileTemplate'@ from a @(FilePath, Text)@ pair.+Both the @FilePath@ and @Text@ may contain mustache variables.++This function returns an error (within @'MonadIO'@) in the case that+@'Text.Mustache.compileMustacheText'@ fails to compile+either the 'fileNameTemplate' or 'fileContentsTemplate'.++For example, the following code:++@+compileFileTemplate ("{{prjId}}.md", "{{prjId}}")+@++produces the following template:++@+MkFileTemplate+ { fileNameTemplate = Template+ { templateActual = PName+ { unPName = "Filename" }+ , templateCache = fromList+ [+ ( PName+ { unPName = "Filename" }+ ,+ [ EscapedVar+ ( Key+ { unKey = [ "prjId" ] }+ )+ , TextBlock ".md"+ ]+ )+ ]+ }+ , fileContentsTemplate = Template+ { templateActual = PName+ { unPName = "Contents" }+ , templateCache = fromList+ [+ ( PName+ { unPName = "Contents" }+ ,+ [ EscapedVar+ ( Key+ { unKey = [ "prjId" ] }+ )+ ]+ )+ ]+ }+ }+@+-}+compileFileTemplate :: MonadIO m => (FilePath, Text) -> m FileTemplate+compileFileTemplate x =+ mkFileTemplate <$> (mkTemplates . bimap+ (compileMustacheText "Filename" . pack)+ (compileMustacheText "Contents") $ x)+ where+ mkTemplates = \case+ (Right fn, Right ctnts) -> pure (fn, ctnts)+ (Left e, _) -> liftIO $ throwIO $ MustacheParserException e+ (_ , Left e) -> liftIO $ throwIO $ MustacheParserException e+ mkFileTemplate = uncurry $ MkFileTemplate (fst x)+++{-|+Generate all @'FileTemplate'@s for a @'ProjectTemplate'@.+-}+compileProjectTemplate :: MonadIO m => [(FilePath, Text)] -> m ProjectTemplate+compileProjectTemplate x =+ MkProjectTemplate . Set.fromList <$> traverse compileFileTemplate x
+ src/ProjectForge/Get.hs view
@@ -0,0 +1,185 @@+{-|+Functions for marshalling Project and File Templates into a program.+-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+module ProjectForge.Get (+ -- * Get Templates+ -- $getTemplates+ getProjectTemplateFromDir+ , getProjectTemplateFromGit+ , getFileTemplateFromFile+) where++import Blammo.Logging.Simple+import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import qualified Data.ByteString as BL+import Data.Maybe (fromMaybe)+import Data.Text+import Data.Text.Encoding+import GHC.Generics+import ProjectForge.Compile+import ProjectForge.Get.Git+import ProjectForge.ProjectTemplate+import System.Directory+import System.FilePath+import System.IO.Temp+import System.Process.Typed++{- $getTemplates++Utilities for converting a directory into a @'ProjectTemplate'@.++-}++{-|+Ways in which getting a project template may go badly.+-}+data GetProjectTemplateError =+ NotADirectory+ | FileNotFound+ | NotAMustacheFile+ | DecodeError+ deriving (Show, Generic)++instance Exception GetProjectTemplateError++{-|+Converts a list of @FilePath@ and @ByteString@ pairs to a @'ProjectTemplate'@.++The @ByteString@ are decoded into @'Data.Text.Text'@ by+@'Data.Text.Encoding.decodeUtf8'@. +If decoding results in a @Data.Text.Encoding.Error.UnicodeException@+for any value,+then this is thrown as an exception.+-}+directoryListToTemplate :: (MonadIO m) =>+ [(FilePath, BL.ByteString)]+ -- | list of (@FilePath@, @ByteString@) pairs+ -- corresponding to the contents of a template directory+ -> m ProjectTemplate+directoryListToTemplate x =+ compileProjectTemplate =<< traverse (traverse decodeToText) x++-- Internal utilitie for converting a bytestring to text.+decodeToText :: MonadIO m => BL.ByteString -> m Text+decodeToText x = case decodeUtf8' x of+ Left e -> liftIO $ throwIO e+ Right v -> pure v++{-|+Convert a file to a @'FileTemplate'@. +A @GetProjectTemplateError@ exception is thrown if the input file+does not exist.++>>> runSimpleLoggingT $ getFileTemplateFromFile "foo.txt"+FileNotFound++-}+getFileTemplateFromFile :: (MonadLogger m, MonadIO m) =>+ FilePath -- ^ name of the file+ -> m FileTemplate+getFileTemplateFromFile f = do+ fileExists <- liftIO $ doesFileExist f+ if fileExists then do+ logDebug $ "Getting template from" :# [ "path" .= f ]+ contents <- decodeToText =<< liftIO (BL.readFile f)+ compileFileTemplate (f, contents)+ else do+ logError $ "File not found" :# [ "path" .= f ]+ liftIO $ throwIO FileNotFound+++{-|+Convert a directory to a @'ProjectTemplate'@. +A @GetProjectTemplateError@ exception is thrown if the input directory+does not exist.++>>> runSimpleLoggingT $ getProjectTemplateFromDir "foo"+NotADirectory++-}+getProjectTemplateFromDir :: (MonadLogger m, MonadIO m) =>+ FilePath -- ^ name of the directory containing template files+ -> m ProjectTemplate+getProjectTemplateFromDir d = do+ dirExists <- liftIO $ doesDirectoryExist d+ if dirExists then do+ logDebug $ "Getting template from" :# [ "path" .= d ]+ listRecursiveDirectoryFiles d >>= directoryListToTemplate+ else do+ logError $ "Directory not found" :# [ "path" .= d ]+ liftIO $ throwIO NotADirectory++{-|+Convert a git repository to a @ProjectTemplate@.++This action creates a shallow clone of the repo in a temporary directory+before calling @'getProjectTemplateFromDir'@ on the temporary directory.+The temporary directory is removed when complete.++This function __requires that__+__[`git` be installed](https://git-scm.com/book/en/v2/Getting-Started-Installing-Git)__.+-}+getProjectTemplateFromGit :: (MonadLogger m, MonadIO m) =>+ -- | Optional parent directory in which to clone the repo in.+ -- Defaults to current directory.+ Maybe FilePath+ -- | The [Git URL](https://www.git-scm.com/docs/git-clone#_git_urls)+ -- of the template directory.+ -> GitURL+ -- | Optional name of git branch.+ -- If @Nothing@, uses default git branch.+ -> Maybe Branch+ -> m ProjectTemplate+getProjectTemplateFromGit baseDir repository branch = do+ tmpDir <- liftIO $ createTempDirectory (fromMaybe "" baseDir) "dir"+ logDebug $ "Created temporary directory for cloning" :# [ "path" .= tmpDir ]++ let cloneArgs = MkGitCloneArgs {+ repository = repository+ , directory = tmpDir+ , branch = branch+ , depth = Just 1+ }++ logDebug $ "Beginning git clone into" :# [ "path" .= tmpDir ]+ liftIO $ runProcess_ (gitClone cloneArgs)++ logDebug $ "Removing .git directory" :# [ "path" .= tmpDir ]+ liftIO $ removeDirectoryRecursive (tmpDir </> ".git")++ logDebug "Getting Project template from cloned directory"+ !template <- getProjectTemplateFromDir tmpDir++ logDebug $ "Removing cloned directory" :# [ "path" .= tmpDir ]+ liftIO $ removeDirectoryRecursive tmpDir++ pure template++{-+The following are basically lifted from:+https://hackage.haskell.org/package/file-embed-lzma-0.0.1/docs/src/FileEmbedLzma.html#listRecursiveDirectoryFiles+-}++listRecursiveDirectoryFiles :: MonadIO m => FilePath -> m [(FilePath, BL.ByteString)]+listRecursiveDirectoryFiles = listDirectoryFilesF listRecursiveDirectoryFiles++listDirectoryFilesF :: MonadIO m =>+ (FilePath -> m [(FilePath, BL.ByteString)]) -- ^ what to do with a sub-directory+ -> FilePath -> m [(FilePath, BL.ByteString)]+listDirectoryFilesF go topdir = do+ names <- liftIO $ getDirectoryContents topdir+ let properNames = Prelude.filter (`notElem` [".", ".."]) names+ paths <- forM properNames $ \name -> do+ let path = topdir </> name+ isDirectory <- liftIO $ doesDirectoryExist path+ if isDirectory+ then go path+ else do+ contents <- liftIO $ BL.readFile path+ pure [(path, contents)]+ pure (Prelude.concat paths)
+ src/ProjectForge/Get/Git.hs view
@@ -0,0 +1,71 @@+{-|+Functions needed for getting templates from remote git repositories+-}++module ProjectForge.Get.Git (+ GitCloneArgs(..)+ , GitURL+ , Branch+ , gitClone+) where++import System.Process.Typed (ProcessConfig, proc)+++-- | A git branch as a @String@.+type Branch = String++-- | A git url as a @String@.+type GitURL = String++{-|+A limited set of arguments for @git clone@ that correspond+to the following command:++@+git clone \+ --branch <OptionalBranch>\+ --depth <OptionalDepth> \+ <repository> \+ <directory>+@++-}+data GitCloneArgs = MkGitCloneArgs {+ -- | [git clone repository](https://www.git-scm.com/docs/git-clone#Documentation/git-clone.txt-ltrepositorygt)+ repository :: !GitURL+ -- | [git clone directory](https://www.git-scm.com/docs/git-clone#Documentation/git-clone.txt-ltdirectorygt)+ , directory :: !FilePath+ -- | [git clone branch](https://www.git-scm.com/docs/git-clone#Documentation/git-clone.txt---branchltnamegt)+ , branch :: !(Maybe Branch)+ -- | [git clone depth](https://www.git-scm.com/docs/git-clone#Documentation/git-clone.txt---depthltdepthgt)+ , depth :: !(Maybe Integer)+ } deriving (Eq, Show)++-- Convert @GitCloneArgs@ to a list for @'System.Process.Typed.proc'@.+cloneArgsToList :: GitCloneArgs -> [String]+cloneArgsToList args =+ maybe [] (\x -> ["--branch", x]) (branch args)+ <> maybe [] (\x-> ["--depth", show x]) (depth args)+ <> [ repository args, directory args ]++{-|+A @'System.Process.Typed.ProcessConfig'@ for:++@+git clone <<args>>+@++NOTE:+According to the+[`typed-process` documentaiton](https://github.com/fpco/typed-process#readme),+"it's highly recommended that you compile any program+using this library with the multi-threaded runtime,+usually by adding ghc-options: -threaded to your executable stanza+in your cabal or package.yaml file.+The single-threaded runtime necessitates some inefficient polling+to be used under the surface."++-}+gitClone :: GitCloneArgs -> ProcessConfig () () ()+gitClone = proc "git" . (["clone"] <>) . cloneArgsToList
+ src/ProjectForge/ProjectTemplate.hs view
@@ -0,0 +1,31 @@+{-|+Defines the template types used internally in ProjectForge+-}+module ProjectForge.ProjectTemplate where++import Data.Set (Set)+import Text.Mustache (Template)++{-|+A @FileTemplate@ is a pair of @'Text.Mustache.Template'@s:+one for a file's name and+one for a file's contents.++See @'ProjectForge.Compile.compileFileTemplate`@ for a utility+to create a @FileTemplate@ from text inputs.+-}+data FileTemplate = MkFileTemplate {+ originalFilename :: !FilePath -- ^ name of the template file+ , fileNameTemplate :: !Template -- ^ template for a file's name+ , fileContentsTemplate :: !Template -- ^ template for contents of a file+ } deriving (Eq, Show, Ord)++{-|+A collection of @'FileTemplate'@ corresponding to all the files+to be produced by an initialization template.+-}+newtype ProjectTemplate = MkProjectTemplate (Set FileTemplate)+ deriving (Eq, Show)++instance Semigroup ProjectTemplate where+ (<>) (MkProjectTemplate x) (MkProjectTemplate y) = MkProjectTemplate (x <> y)
+ src/ProjectForge/Reexports.hs view
@@ -0,0 +1,12 @@+module ProjectForge.Reexports (+ Value+ , Text+ , MonadIO+ , module Blammo.Logging.Simple+)+where++import Blammo.Logging.Simple+import Control.Monad.IO.Class (MonadIO)+import Data.Aeson (Value)+import Data.Text.Lazy (Text)
+ src/ProjectForge/Render.hs view
@@ -0,0 +1,130 @@+{-|+Functions for rendering Project and File Templates.++Rendering a @'Template'@ interpolates the partial values in a @Template@+with values from a @'Data.Aeson.Value'@.+-}+{-# LANGUAGE OverloadedStrings #-}++module ProjectForge.Render (+ -- * Rendering templates+ renderFileTemplate+ , renderProjectTemplate++ -- ** Rendering Options and Exception Handling+ , RenderTemplateOpts(..)+ , RenderWarnHandling(..)+ , RenderException+ , defaultRenderTemplateOpts++) where++import Blammo.Logging.Simple+import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import qualified Data.Aeson as AE+import Data.Bifunctor+import qualified Data.Set as Set+import Data.Text+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import ProjectForge.ProjectTemplate+import System.FilePath+import Text.Mustache.Render+import Text.Mustache.Type++{-| Flag for how to handle any '@Text.Stache.Type.MustacheWarning'@s+that may result from @'renderFileTemplate'@.+-}+data RenderWarnHandling =+ -- | lift mustache warnings to errors+ WarningAsError+ -- | Ignore warnings+ | Ignore+ deriving (Eq, Show)++-- | New type wrapper for a list of '@Text.Stache.Type.MustacheWarning'@s+-- so that it can be made an instance of @'Control.Exception.Exception'@.+newtype RenderException = MkRenderException [MustacheWarning]+ deriving (Eq, Show)++instance Exception RenderException++{-| Options to control how @'renderFileTemplate'@ is run.+-}+newtype RenderTemplateOpts =+ MkRenderTemplateOpts { handleWarnings :: RenderWarnHandling }+ deriving (Eq, Show)++-- | Default @'RenderTemplateOpts'@+defaultRenderTemplateOpts :: RenderTemplateOpts+defaultRenderTemplateOpts = MkRenderTemplateOpts {+ handleWarnings = Ignore+}++{-|+Renders a @'FileTemplate'@ using @'Text.Mustache.renderMustache'@.+Values to be input into the template are presented+via a @'Data.Aeson.Value'@ representation.++>>> import Data.Aeson (toJSON, object, (.=))+>>> import ProjectForge.Compile+>>> import Blammo.Logging.Simple+>>> let settings = toJSON (object [ "prjId" .= "P0000"])+>>> let exampleTemplate = compileFileTemplate ("{{prjId}}.md", "This is {{prjId}}")+>>> runSimpleLoggingT . (\x -> renderFileTemplate defaultRenderTemplateOpts x settings) =<< exampleTemplate+([],("P0000.md","This is P0000"))++-}+renderFileTemplate :: (MonadLogger m, MonadIO m) =>+ RenderTemplateOpts+ -> FileTemplate+ -> AE.Value -- ^ values to interpolate into the template+ -> m (FilePath, TL.Text)+renderFileTemplate opts (MkFileTemplate ofn fn ct) v = do++ logInfo $ "Rendering template" :# [ "templatePath" .= ofn ]++ let rendered = reshape $ bimap render render (fn, ct)++ -- handle warnings, if any+ unless (Prelude.null (fst rendered) )+ (do++ let logWarnWhere = case handleWarnings opts of+ WarningAsError -> logError+ Ignore -> logWarn++ logWarnWhere $ "Rendering resulted in warnings" :#+ [ "fileNameTemplate" .= fst (snd rendered)+ , "warnings" .=+ intercalate "\n" (fmap (pack . displayMustacheWarning) (fst rendered)) ]++ case handleWarnings opts of+ WarningAsError -> liftIO $ throwIO (MkRenderException (fst rendered))+ Ignore -> pure ()+ )++ pure (snd rendered)++ where render = flip renderMustacheW v+ reshape (x, y) =+ ( fst x ++ fst y+ , (( unpack . TL.toStrict ) $ snd x, snd y))++{-|+Renders a @'ProjectTemplate'@,+returning a list of filepaths and file contents+that may be written to files.+-}+renderProjectTemplate :: (MonadIO m, MonadLogger m) =>+ RenderTemplateOpts+ -> ProjectTemplate+ -- | values to interpolate into each @'FileTemplate'@+ -- of the @'ProjectTemplate'@+ -> AE.Value+ -> m [(FilePath, TL.Text)]+renderProjectTemplate opts (MkProjectTemplate t) v =+ traverse (`f` v) (Set.toList t)+ where f = renderFileTemplate opts