hscaffold 0.3.0.0 → 0.4.0.0
raw patch · 12 files changed
+573/−182 lines, 12 filesdep +regex-compatdep +temporarynew-component:exe:hsfiles-from-directory
Dependencies added: regex-compat, temporary
Files
- bin/HsfilesFromDirectory.hs +14/−0
- hscaffold.cabal +28/−3
- src/Hscaffold.hs +35/−159
- src/Hscaffold/EDSL.hs +107/−0
- src/Hscaffold/Generator/Directory.hs +45/−0
- src/Hscaffold/Generator/Hsfiles.hs +37/−0
- src/Hscaffold/Interpreter/Common.hs +14/−0
- src/Hscaffold/Interpreter/Haskell.hs +38/−0
- src/Hscaffold/Interpreter/Hsfiles.hs +41/−0
- src/Hscaffold/Interpreter/IO.hs +52/−0
- src/Hscaffold/Types.hs +32/−0
- test/HscaffoldSpec.hs +130/−20
+ bin/HsfilesFromDirectory.hs view
@@ -0,0 +1,14 @@+import qualified Data.Text.IO as Text+import Hscaffold+import System.Environment++main :: IO ()+main = do+ as <- getArgs+ case as of+ (fp:_) -> go fp+ [] -> error "Usage: hsfiles-from-directory <DIRECTORY>"+ where+ go fp = do+ ws <- hscaffoldFromDirectory fp+ Text.putStr $ toHsfiles (tell ws)
hscaffold.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: hscaffold-version: 0.3.0.0+version: 0.4.0.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@@ -33,14 +33,37 @@ , directory , filepath , unix+ , regex-compat exposed-modules: Hscaffold- other-modules:- Paths_hscaffold+ Hscaffold.EDSL+ Hscaffold.Generator.Directory+ Hscaffold.Generator.Hsfiles+ Hscaffold.Interpreter.Common+ Hscaffold.Interpreter.Haskell+ Hscaffold.Interpreter.Hsfiles+ Hscaffold.Interpreter.IO+ Hscaffold.Types hs-source-dirs: src default-language: Haskell2010 +executable hsfiles-from-directory+ main-is: HsfilesFromDirectory.hs+ hs-source-dirs:+ bin+ build-depends:+ base >=4.8 && <4.9+ , text+ , mtl+ , transformers+ , directory+ , filepath+ , unix+ , regex-compat+ , hscaffold+ default-language: Haskell2010+ test-suite hspec type: exitcode-stdio-1.0 main-is: Spec.hs@@ -54,9 +77,11 @@ , directory , filepath , unix+ , regex-compat , hspec , hscaffold , QuickCheck+ , temporary other-modules: HscaffoldSpec SanitySpec
src/Hscaffold.hs view
@@ -1,15 +1,28 @@ -- module: Hscaffold -- author: Pedro Tacla Yamada -- synopsis: Very simple file/directory structure scaffolding writer monad EDSL-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-} module Hscaffold ( -- * Running Hscaffold runHscaffold+ -- * Convert Hscaffold to HSFILES (@stack templates@)+ , toHsfiles+ , writeToHsfiles+ -- * Convert HSFILES to Hscaffold+ , fromHsfiles+ , fromHsfilesW+ , readHsfiles++ -- * Convert a directory to Hscaffold+ , hscaffoldFromDirectory+ -- * Compile Hscaffold to Haskell code+ , hscaffoldToHaskell++ -- ** Finer grained runners , runAction , runWriter , runWriterT@@ -30,12 +43,19 @@ , Permissions(..) -- * Types+ , ScaffoldMonadT+ , ScaffoldMonadIO , ScaffoldActionType(..) , ScaffoldAction , ScaffoldActionV+ , ScaffoldMonadET + -- * Helpers+ , runHscaffoldIO+ , mkActionPath+ -- * Re-exports- , module Data.Text+ , Text , module Control.Monad.IO.Class , module Control.Monad.Writer , module System.Directory@@ -43,162 +63,18 @@ ) where -import Control.Applicative import Control.Monad.IO.Class import Control.Monad.Writer-import Data.Text (Text)-import qualified Data.Text-import qualified Data.Text.IO as Text+import Data.Text (Text) import System.Directory -- TODO - Disable this on Windows import System.FilePath-import System.Posix.Files ---- | 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-runAction root (Copy fp1 fp2) = do- let fp1' = makeAbsolute fp1- fp2' = makeAbsolute fp2- copyFile fp1' fp2'- where- makeAbsolute fp = if isAbsolute fp then fp else root </> fp---- | 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- | Copy FilePath 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]---- | Write the empty string to a file-touch- :: MonadWriter (ScaffoldAction e) m- => FilePath- -> m ()-touch fp = file fp ""---- | Write the empty string to a file with given permissions-touchWith- :: MonadWriter (ScaffoldAction e) m- => Permissions- -> FilePath- -> m ()-touchWith perms fp = fileWith perms fp ""---- | Copy a file from A to B------ Non-absolute paths are treated relative to the *current* root, nested blocks--- change the root-copy- :: MonadWriter (ScaffoldAction e) m- => FilePath- -> FilePath- -> m ()-copy fp1 fp2 = tell [Copy fp1 fp2]---- | Copy a file from A to B and set permissions on B, see 'copy'-copyWith- :: MonadWriter (ScaffoldAction e) m- => Permissions- -> FilePath- -> FilePath- -> m ()-copyWith perms fp1 fp2 = do- copy fp1 fp2- permissions fp2 perms+import Hscaffold.EDSL+import Hscaffold.Generator.Directory+import Hscaffold.Generator.Hsfiles+import Hscaffold.Interpreter.Common+import Hscaffold.Interpreter.Haskell+import Hscaffold.Interpreter.Hsfiles+import Hscaffold.Interpreter.IO+import Hscaffold.Types
+ src/Hscaffold/EDSL.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+module Hscaffold.EDSL+ where++import Control.Monad.Writer+import Data.Text (Text)+import System.Directory++import Hscaffold.Types++-- | 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]++-- | Write the empty string to a file+touch+ :: MonadWriter (ScaffoldAction e) m+ => FilePath+ -> m ()+touch fp = file fp ""++-- | Write the empty string to a file with given permissions+touchWith+ :: MonadWriter (ScaffoldAction e) m+ => Permissions+ -> FilePath+ -> m ()+touchWith perms fp = fileWith perms fp ""++-- | Copy a file from A to B+--+-- Non-absolute paths are treated relative to the *current* root, nested blocks+-- change the root+copy+ :: MonadWriter (ScaffoldAction e) m+ => FilePath+ -> FilePath+ -> m ()+copy fp1 fp2 = tell [Copy fp1 fp2]++-- | Copy a file from A to B and set permissions on B, see 'copy'+copyWith+ :: MonadWriter (ScaffoldAction e) m+ => Permissions+ -> FilePath+ -> FilePath+ -> m ()+copyWith perms fp1 fp2 = do+ copy fp1 fp2+ permissions fp2 perms
+ src/Hscaffold/Generator/Directory.hs view
@@ -0,0 +1,45 @@+module Hscaffold.Generator.Directory+ where++import Data.List+import qualified Data.Text.IO as Text+import System.Directory+import System.FilePath++import Hscaffold.Types++-- | Converts a directory to scaffold actions+hscaffoldFromDirectory :: FilePath -> IO (ScaffoldAction e)+hscaffoldFromDirectory =+ hscaffoldFromDirectoryWith (filter (not . ("." `isPrefixOf`)))++-- | Converts a directory to scaffold actions with a custom filter function. By+-- default we ignore directories starting with @.@+hscaffoldFromDirectoryWith+ :: ([FilePath] -> [FilePath]) -> FilePath -> IO (ScaffoldAction e)+hscaffoldFromDirectoryWith = hscaffoldFromDirectoryWith' False++hscaffoldFromDirectoryWith'+ :: Traversable t =>+ Bool+ -> ([FilePath] -> t FilePath)+ -> FilePath+ -> IO [ScaffoldActionType e]+hscaffoldFromDirectoryWith' isRecur p root = do+ ls <- p <$> getDirectoryContents root+ concat <$> mapM classify ls+ where+ fromFile fp' fp = do+ txt <- Text.readFile fp'+ return [ File (normalise fp) txt ]+ fromDir =+ hscaffoldFromDirectoryWith' True p+ classify fp = do+ let fp' = root </> fp+ isfl <- doesFileExist fp'+ isdir <- doesDirectoryExist fp'+ if isfl+ then fromFile fp' (if isRecur then fp' else fp)+ else if isdir+ then fromDir fp'+ else return []
+ src/Hscaffold/Generator/Hsfiles.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+module Hscaffold.Generator.Hsfiles+ where++import Control.Arrow+import Control.Monad.Writer+import qualified Data.Text as Text+-- TODO - Disable this on Windows+import System.FilePath+import Text.Regex++import Hscaffold.Types++-- | Converts hsfiles to hscaffold actions+fromHsfiles :: String -> ScaffoldAction e+fromHsfiles h =+ let (_, r) = foldr helper ("", []) matches+ in r+ where+ helper (Just (fp:_), _) (lacc, current) =+ ( ""+ , File (normalise fp) lacc:current+ )+ helper (_, l) (lacc, current) =+ ( Text.stripEnd (l <> "\n" <> lacc)+ , current+ )+ re = mkRegex "^{-# START_FILE (.+) #-}( +)?$"+ matches = map (matchRegex re &&& Text.pack) (lines h)++-- | Converts hsfiles to a hscaffold monad+fromHsfilesW :: MonadWriter (ScaffoldAction e) m => String -> m ()+fromHsfilesW h = tell (fromHsfiles h)++readHsfiles :: FilePath -> IO (ScaffoldAction e)+readHsfiles fp = fromHsfiles <$> readFile fp
+ src/Hscaffold/Interpreter/Common.hs view
@@ -0,0 +1,14 @@+module Hscaffold.Interpreter.Common+ where++import System.FilePath++-- | Very simple helper, if the second argument is absolute, returns it,+-- otherwise, return it relative to the first argument+mkActionPath+ :: FilePath+ -- ^ The root+ -> FilePath+ -- ^ A filepath+ -> FilePath+mkActionPath root fp = if isAbsolute fp then fp else root </> fp
+ src/Hscaffold/Interpreter/Haskell.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE OverloadedStrings #-}+module Hscaffold.Interpreter.Haskell+ where++import Control.Monad.Writer+import Data.Text (Text)+import qualified Data.Text as Text++import Hscaffold.Types++-- | Generates Haskell code from scaffold actions+hscaffoldToHaskell :: Foldable t => t (ScaffoldActionType e) -> Text+hscaffoldToHaskell hs = Text.stripEnd $+ Text.unlines $+ concatMap hscaffoldActionToHaskell hs++hscaffoldActionToHaskell :: ScaffoldActionType e -> [Text]+hscaffoldActionToHaskell h = case h of+ (File fp txt) ->+ [ "file " <> Text.pack (show fp <> " " <> show txt) ]+ (Directory fp nested) ->+ let nestedCode = concatMap hscaffoldActionToHaskell nested+ inestedCode = map (" " <>) nestedCode+ in [ "directory " <> Text.pack (show fp) <> " $ do"+ ] <> inestedCode+ (Link fp1 fp2) ->+ [ "link " <> Text.pack (show fp1) <> " "+ <> Text.pack (show fp2)+ ]+ (SetPermissions p fp) ->+ [ "permissions " <> Text.pack (show fp)+ <> " (" <> Text.pack (show p) <> ")"+ ]+ (Copy fp1 fp2) ->+ [ "copy " <> Text.pack (show fp1)+ <> " " <> Text.pack (show fp2)+ ]+ _ -> []
+ src/Hscaffold/Interpreter/Hsfiles.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+module Hscaffold.Interpreter.Hsfiles+ where++import Control.Monad.Writer+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text++import Hscaffold.Types++import Hscaffold.Interpreter.Common++-- | Run the scaffolding writer and return an @.hsfiles@ 'Text' to use with+-- @stack-templates@+toHsfiles :: Writer ScaffoldActionV a -> Text+toHsfiles w =+ let (_, ws) = runWriter w+ in Text.stripEnd $ Text.unlines $+ concatMap (actionToHsfile ".") ws++-- | Convert a single scaffolding action to hsfiles+--+-- Ignores everything but the 'file' directives+actionToHsfile :: FilePath -> ScaffoldActionType e -> [Text]+actionToHsfile root a = case a of+ (File fp txt) ->+ [ "{-# START_FILE " <> Text.pack (mkActionPath root fp) <> " #-}" ] <>+ Text.lines txt+ (Directory fp nested) -> concatMap (actionToHsfile (mkActionPath root fp)) nested+ _ -> []++-- | Shortcut for+--+-- @+-- writeToHsfiles = do h <- toHsfiles w; liftIO $ Text.writeFile fp h+-- @+writeToHsfiles :: MonadIO m => FilePath -> Writer ScaffoldActionV a -> m ()+writeToHsfiles fp w = do+ let h = toHsfiles w+ liftIO $ Text.writeFile fp h
+ src/Hscaffold/Interpreter/IO.hs view
@@ -0,0 +1,52 @@+module Hscaffold.Interpreter.IO+ where++import Control.Monad.IO.Class+import Control.Monad.Writer+import qualified Data.Text.IO as Text+import System.Directory+-- TODO - Disable this on Windows+import System.Posix.Files++import Hscaffold.Types++import Hscaffold.Interpreter.Common++-- | 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 :: MonadIO m => FilePath -> WriterT ScaffoldActionV m a -> m a+runHscaffold root w = do+ (o, ws) <- runWriterT w+ liftIO $ mapM_ (runAction root) ws+ return o++runHscaffoldIO :: FilePath -> ScaffoldMonadIO a -> IO a+runHscaffoldIO = runHscaffold++-- | Run a single scaffolding action on the IO monad with no extensions+runAction :: FilePath -> ScaffoldActionType e -> IO ()+runAction _ (ScaffoldActionTypeExtension _) = return ()+runAction root (SetPermissions perms fp) =+ setPermissions (mkActionPath root fp) perms+runAction root (Link fp1 fp2) =+ createSymbolicLink (mkActionPath root fp1) (mkActionPath root fp2)+runAction root (File fp txt) =+ Text.writeFile (mkActionPath root fp) txt+runAction root (Directory fp nested) = do+ createDirectoryIfMissing True (mkActionPath root fp)+ mapM_ (runAction (mkActionPath root fp)) nested+runAction root (Copy fp1 fp2) = do+ let fp1' = mkActionPath root fp1+ fp2' = mkActionPath root fp2+ copyFile fp1' fp2'+
+ src/Hscaffold/Types.hs view
@@ -0,0 +1,32 @@+module Hscaffold.Types+ where++import Control.Monad.Writer+import Data.Text (Text)+import System.Directory++-- | The writer monad transformer for scaffold actions+type ScaffoldMonadT m a = WriterT ScaffoldActionV m a++-- | The writer monad for scaffold actions, running in IO+type ScaffoldMonadIO a = WriterT ScaffoldActionV IO a++-- | The writer monad transformer for scaffold actions with an extension+type ScaffoldMonadET e m a = WriterT (ScaffoldAction e) m a++-- | 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+ | Copy FilePath FilePath+ | ScaffoldActionTypeExtension e+ deriving(Show, Eq, Ord)
test/HscaffoldSpec.hs view
@@ -4,50 +4,160 @@ import Control.Exception import Control.Monad+import Data.Maybe+import qualified Data.Text as Text import Hscaffold-import System.Directory+import System.IO.Temp import Test.Hspec +directoryShouldExist dir = do+ e <- doesDirectoryExist dir+ e `shouldBe` True++fileShouldExist fp = do+ e <- doesFileExist fp+ e `shouldBe` True++fileShouldHaveContents fp txt = do+ e <- readFile fp+ e `shouldBe` txt++spec :: Spec spec = do- describe "the writers" $ do+ describe "the writers" $ 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" ""+ 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" ""- ]+ , Directory "./something"+ [ File "stuff-here.hs" ""+ , File "stuff-there.hs" ""+ ] ] - describe "the runner" $ do+ describe "runHscaffold" $+ it "works without surprises" $ do+ withSystemTempDirectory "hscaffold" $+ \tmp -> do+ runHscaffold tmp $ do+ file "stuff-bang.hs" ""+ directory "./something" $ do+ file "stuff-here.hs" ""+ file "stuff-there.hs" ""+ directoryShouldExist (tmp </> "something")+ fileShouldExist (tmp </> "stuff-bang.hs")+ fileShouldExist (tmp </> "something" </> "stuff-here.hs")+ fileShouldExist (tmp </> "something" </> "stuff-there.hs")++ describe "toHsfiles" $ do+ it "works without surprises" $+ let h = toHsfiles $ do+ file "stuff-bang.hs" "stuff here"+ file "other/stuff-bang.hs" "stuff here"+ directory "other" $ do+ file "other-stuff-bang.hs" "even more stuff here"+ in h `shouldBe` Text.stripEnd+ (Text.unlines [ "{-# START_FILE ./stuff-bang.hs #-}"+ , "stuff here"+ , "{-# START_FILE ./other/stuff-bang.hs #-}"+ , "stuff here"+ , "{-# START_FILE ./other/other-stuff-bang.hs #-}"+ , "even more stuff here"+ ])++ describe "fromHsfiles" $ do+ it "works without surprises" $+ let h = (init+ (unlines+ [ "{-# START_FILE ./stuff-bang.hs #-}"+ , "stuff here"+ , "{-# START_FILE ./other/stuff-bang.hs #-}"+ , "stuff here"+ , "{-# START_FILE ./other/other-stuff-bang.hs #-}"+ , "even more stuff here"+ ]))+ in (fromHsfiles h :: ScaffoldActionV) `shouldBe`+ [ File "stuff-bang.hs" "stuff here"+ , File "other/stuff-bang.hs" "stuff here"+ , File "other/other-stuff-bang.hs" "even more stuff here"+ ]++ it "works without surprises" $+ let h = (init+ (unlines+ [ "{-# START_FILE ./stuff-bang.hs #-}"+ , "stuff here"+ , "multiline"+ , " ya"+ , "{-# START_FILE ./other/stuff-bang.hs #-}"+ , "stuff here"+ , ""+ , "{-# START_FILE ./other/other-stuff-bang.hs #-} "+ , "even more stuff here"+ , " here too"+ ]))+ in (fromHsfiles h :: ScaffoldActionV) `shouldBe`+ [ File "stuff-bang.hs" "stuff here\nmultiline\n ya"+ , File "other/stuff-bang.hs" "stuff here"+ , File "other/other-stuff-bang.hs" "even more stuff here\n here too"+ ]++ describe "hscaffoldToHaskell" $ do+ it "works without surprises" $+ let h = hscaffoldToHaskell $ execWriter $ do+ file "stuff-bang.hs" "stuff here"+ file "other/stuff-bang.hs" "stuff here"+ directory "other" $ do+ file "other-stuff-bang.hs" "even more stuff here"+ in h `shouldBe` Text.stripEnd+ (Text.unlines [ "file \"stuff-bang.hs\" \"stuff here\""+ , "file \"other/stuff-bang.hs\" \"stuff here\""+ , "directory \"other\" $ do"+ , " file \"other-stuff-bang.hs\" \"even more stuff here\""+ ])++ describe "hscaffoldFromDirectory" $ do+ it "works without surprises" $ do+ h <- hscaffoldFromDirectory "./src" :: IO (ScaffoldActionV)+ let ms = mapMaybe (\x -> case x of File fp _ -> Just fp; _ -> Nothing) h+ ms `shouldContain` ["Hscaffold.hs"]++ it "ignores git" $ do+ h <- hscaffoldFromDirectory "." :: IO (ScaffoldActionV)+ let ms = mapMaybe (\x -> case x of File fp _ -> Just fp; _ -> Nothing) h+ ms `shouldNotContain` [".git/index"]+ ms `shouldContain` ["README.md"]+ ms `shouldContain` ["test/Spec.hs"]++ describe "the runner" $ describe "runAction" $ do it "creates files" $ do- void $ (try $ removeDirectoryRecursive "./tmp" :: IO (Either SomeException ()))- void $ (try $ removeFile "./tmp" :: IO (Either SomeException ()))+ 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 ()))+ 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 ()))+ 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 ()))+ 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"])+ 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 ()))+ void (try $ removeDirectoryRecursive "./tmp" :: IO (Either SomeException ())) let Right cnts = ecnts cnts `shouldBe` "here"