hscaffold (empty) → 0.1.1.0

raw patch · 9 files changed

+307/−0 lines, 9 filesdep +QuickCheckdep +basedep +directorysetup-changed

Dependencies added: QuickCheck, base, directory, filepath, hscaffold, hspec, mtl, text, unix

Files

• ChangeLog.md +5/−0
• LICENSE +20/−0
• README.md +15/−0
• Setup.hs +2/−0
• hscaffold.cabal +61/−0
• src/Hscaffold.hs +144/−0
• test/HscaffoldSpec.hs +53/−0
• test/SanitySpec.hs +6/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,5 @@+# Revision history for hscaffold++## 0.1.0.0  -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,20 @@+Copyright (c) 2016 Pedro Tacla Yamada++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,15 @@+# hscaffold+Very simple file/directory structure scaffolding writer monad EDSL+```haskell+runHscaffold "." $ do+    file "./.gitignore" (Text.unlines [ ".stack-work"+                                      , "stuff"+                                      , "here"+                                      ])+    directory "./src" $ do+        file "./Main.hs" "main = putStrLn \"Hello World\""+        file "./Other.hs" "other = putStrLn \"Hello You\""+```++## License+MIT

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

@@ -0,0 +1,61 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name:           hscaffold+version:        0.1.1.0+synopsis:       Very simple file/directory structure scaffolding writer monad EDSL+description:     See our README on GitHub at <https://github.com/yamadapc/hscaffold> +homepage:       https://github.com/yamadapc/hscaffold#readme+bug-reports:    https://github.com/yamadapc/hscaffold/issues+license:        MIT+license-file:   LICENSE+author:         Pedro Tacla Yamada+maintainer:     tacla.yamada@gmail.com+category:       Development+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/yamadapc/hscaffold++library+  build-depends:+      base >=4.8 && <4.9+    , text+    , mtl+    , directory+    , filepath+    , unix+  exposed-modules:+      Hscaffold+  other-modules:+      Paths_hscaffold+  hs-source-dirs:+      src+  default-language: Haskell2010++test-suite hspec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  build-depends:+      base >=4.8 && <4.9+    , text+    , mtl+    , directory+    , filepath+    , unix+    , hspec+    , hscaffold+    , QuickCheck+  other-modules:+      HscaffoldSpec+      SanitySpec+  default-language: Haskell2010

@@ -0,0 +1,144 @@+-- module: Hscaffold+-- author: Pedro Tacla Yamada+-- synopsis: Very simple file/directory structure scaffolding writer monad EDSL+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Hscaffold+    ( runHscaffold+    , runAction+    , runWriter+    , runWriterT++    , directory+    , file+    , link+    , Permissions(..)+    , fileWith+    , directoryWith+    , permissions++    , ScaffoldActionType(..)+    , ScaffoldAction+    , ScaffoldActionV++    , module Data.Text+    , module Control.Monad.Writer+    , module System.Directory+    , module System.FilePath+    )+  where++import           Control.Applicative+import           Control.Monad.Writer+import           Data.Text                (Text)+import qualified Data.Text+import qualified Data.Text.IO as Text+import           System.Directory+-- TODO - Disable this on Windows+import           System.Posix.Files+import           System.FilePath+++-- | Run the scaffolding writer on the IO monad with no extensions+--+-- @+-- runHscaffold "." $ do+--     file "./.gitignore" (Text.unlines [ ".stack-work"+--                                       , "stuff"+--                                       , "here"+--                                       ])+--     directory "./src" $ do+--         file "./Main.hs" "main = putStrLn \\"Hello World\\""+--         file "./Other.hs" "other = putStrLn \\"Hello You\\""+-- @+runHscaffold :: FilePath -> WriterT ScaffoldActionV IO a -> IO a+runHscaffold root w = do+    (o, ws) <- runWriterT w+    mapM_ (runAction root) ws+    return o++-- | Run a single scaffolding action on the IO monad with no extensions+runAction :: FilePath -> ScaffoldActionType () -> IO ()+runAction root (SetPermissions perms fp) =+    setPermissions fp perms+runAction root (Link fp1 fp2) =+    createSymbolicLink fp1 fp2+runAction root (File fp txt) =+    Text.writeFile (root </> fp) txt+runAction root (Directory fp nested) = do+    createDirectoryIfMissing True (root </> fp)+    mapM_ (runAction (root </> fp)) nested++-- | Accumulator for actions+type ScaffoldAction e = [ScaffoldActionType e]++-- | Accumulator for actions set with void extension+type ScaffoldActionV = ScaffoldAction ()++-- | Type of actions scaffolding can make, 'ScaffoldActionTypeExtension' is open+-- for extension through other data-types+data ScaffoldActionType e = File FilePath Text+                          | Link FilePath FilePath+                          | Directory FilePath (ScaffoldAction e)+                          | SetPermissions Permissions FilePath+                          | ScaffoldActionTypeExtension e+  deriving(Show, Eq, Ord)++-- | Create a directory with the nested contents+directory+    :: MonadWriter (ScaffoldAction e) m+    => FilePath+    -> WriterT (ScaffoldAction e) m b+    -> m b+directory fp nested = do+    (x, nested') <- runWriterT nested+    tell [Directory fp nested']+    return x++-- | Create a directory with the nested contents and permissions+directoryWith+    :: MonadWriter (ScaffoldAction e) m+    => Permissions+    -> FilePath+    -> WriterT (ScaffoldAction e) m b+    -> m b+directoryWith perms fp nested = do+    x <- directory fp nested+    tell [SetPermissions perms fp]+    return x++-- | Create a file with the given contents+file+    :: MonadWriter (ScaffoldAction e) m+    => FilePath+    -> Text+    -> m ()+file fp txt = tell [File fp txt]++-- | Create a file with the given contents and permissions+fileWith+    :: MonadWriter (ScaffoldAction e) m+    => Permissions+    -> FilePath+    -> Text+    -> m ()+fileWith perms fp txt = do+    file fp txt+    tell [SetPermissions perms fp]++-- | Set permissions on a filepath+permissions+    :: MonadWriter (ScaffoldAction e) m+    => FilePath+    -> Permissions+    -> m ()+permissions fp perms = tell [SetPermissions perms fp]++-- | Create a symbolic link between two filepaths+link+    :: MonadWriter (ScaffoldAction e) m+    => FilePath+    -> FilePath+    -> m ()+link fp1 fp2 = tell [Link fp1 fp2]

@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}+module HscaffoldSpec+  where++import           Control.Exception+import           Control.Monad+import           Hscaffold+import           System.Directory++import           Test.Hspec++spec = do+    describe "the writers" $ do+        it "create proper instructions for our results" $ do+            let (_, ws) = runWriter $ do+                          file "stuff-bang.hs" ""+                          directory "./something" $ do+                              file "stuff-here.hs" ""+                              file "stuff-there.hs" ""+            (ws :: ScaffoldAction ())+                `shouldBe` [ File "stuff-bang.hs" ""+                           , Directory "./something" [ File "stuff-here.hs" ""+                                                     , File "stuff-there.hs" ""+                                                     ]+                           ]++    describe "the runner" $ do+        describe "runAction" $ do+            it "creates files" $ do+                void $ (try $ removeDirectoryRecursive "./tmp" :: IO (Either SomeException ()))+                void $ (try $ removeFile "./tmp" :: IO (Either SomeException ()))+                runAction "." (File "./tmp" "stuff")+                ecnts <- try $ readFile "./tmp" :: IO (Either SomeException String)+                void $ (try $ removeFile "./tmp" :: IO (Either SomeException ()))+                let Right cnts = ecnts+                cnts `shouldBe` "stuff"++            it "creates directories" $ do+                void $ (try $ removeDirectoryRecursive "./tmp" :: IO (Either SomeException ()))+                void $ (try $ removeFile "./tmp" :: IO (Either SomeException ()))+                runAction "." (Directory "./tmp/" [])+                t <- doesDirectoryExist "./tmp"+                void $ (try $ removeDirectoryRecursive "./tmp" :: IO (Either SomeException ()))+                t `shouldBe` True++            it "creates directory contents" $ do+                void $ (try $ removeDirectoryRecursive "./tmp" :: IO (Either SomeException ()))+                void $ (try $ removeFile "./tmp" :: IO (Either SomeException ()))+                runAction "." (Directory "./tmp/" [File "stuff" "here"])+                ecnts <- try $ readFile "./tmp/stuff" :: IO (Either SomeException String)+                void $ (try $ removeDirectoryRecursive "./tmp" :: IO (Either SomeException ()))+                let Right cnts = ecnts+                cnts `shouldBe` "here"

@@ -0,0 +1,6 @@+module SanitySpec where++import Test.Hspec++spec = describe "when I have tests" $+    it "I have sanity" $ True `shouldBe` True

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