super-user-spark 0.4.0.0 → 0.4.0.1

raw patch · 35 files changed

+248/−281 lines, 35 filesdep −HUnitdep −iostringdep ~QuickCheckdep ~aesondep ~aeson-prettyPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: HUnit, iostring

Dependency ranges changed: QuickCheck, aeson, aeson-pretty, bytestring, directory, filepath, genvalidity, genvalidity-hspec, genvalidity-hspec-aeson, genvalidity-path, hashable, mtl, optparse-applicative, parsec, path, path-io, process, text, unix, validity, validity-path

API changes (from Hackage documentation)

Files

• src/Import.hs +1/−2
• src/SuperUserSpark/Bake.hs +3/−4
• src/SuperUserSpark/Bake/Internal.hs +11/−14
• src/SuperUserSpark/Check.hs +1/−1
• src/SuperUserSpark/Check/Internal.hs +8/−9
• src/SuperUserSpark/Check/Types.hs +1/−2
• src/SuperUserSpark/Compiler.hs +4/−3
• src/SuperUserSpark/Compiler/Internal.hs +8/−10
• src/SuperUserSpark/Compiler/Types.hs +1/−1
• src/SuperUserSpark/Compiler/Utils.hs +3/−3
• src/SuperUserSpark/Deployer/Internal.hs +2/−6
• src/SuperUserSpark/Diagnose.hs +2/−1
• src/SuperUserSpark/Diagnose/Internal.hs +14/−18
• src/SuperUserSpark/Diagnose/Types.hs +12/−4
• src/SuperUserSpark/OptParse/Types.hs +4/−4
• src/SuperUserSpark/Parser.hs +1/−1
• src/SuperUserSpark/Parser/Internal.hs +23/−29
• src/SuperUserSpark/Parser/Types.hs +2/−3
• src/SuperUserSpark/Utils.hs +0/−1
• super-user-spark.cabal +22/−25
• test/SuperUserSpark/BakeSpec.hs +13/−5
• test/SuperUserSpark/Check/TestUtils.hs +8/−18
• test/SuperUserSpark/Compiler/Gen.hs +1/−5
• test/SuperUserSpark/Compiler/TestUtils.hs +1/−1
• test/SuperUserSpark/CompilerSpec.hs +4/−4
• test/SuperUserSpark/DeployerSpec.hs +6/−6
• test/SuperUserSpark/Diagnose/TestUtils.hs +0/−2
• test/SuperUserSpark/DiagnoseSpec.hs +5/−4
• test/SuperUserSpark/EndToEnd/RegressionSpec.hs +35/−36
• test/SuperUserSpark/EndToEndSpec.hs +4/−4
• test/SuperUserSpark/Parser/Gen.hs +3/−3
• test/SuperUserSpark/Parser/TestUtils.hs +2/−2
• test/SuperUserSpark/ParserSpec.hs +41/−46
• test/TestImport.hs +1/−3
• test/TestUtils.hs +1/−1

@@ -2,7 +2,7 @@     ( module X     ) where -import Prelude as X hiding (readFile, appendFile, writeFile, putStr, putStrLn)+import Prelude as X hiding (appendFile)  import Control.Arrow as X import Data.Maybe as X@@ -10,7 +10,6 @@ import System.Exit as X import Text.Read as X (readEither) -import Data.IOString as X import Path as X import Path.IO as X 

@@ -17,6 +17,7 @@ import Import  import qualified Data.Aeson.Encode.Pretty as JSON+import qualified Data.ByteString.Lazy.Char8 as LB import System.Environment (getEnvironment) import System.FilePath (takeExtension) @@ -57,9 +58,7 @@              parseStrongCardFileReference f)         _ -> pure $ Left $ unwords ["Could not parse card reference from:", s] -deriveBakeSettings :: BakeCardReference-                   -> BakeFlags-                   -> IO (Either String BakeSettings)+deriveBakeSettings :: BakeCardReference -> BakeFlags -> IO (Either String BakeSettings) deriveBakeSettings bcr BakeFlags {..} =     BakeSettings (rootOf bcr) <$$> (Right <$> getEnvironment) <**>     deriveCompileSettings bakeCompileFlags@@ -87,7 +86,7 @@ bakeByCardRef bakeCardReference = do     deps <- compileBakeCardRef bakeCardReference     bdeps <- bakeDeployments deps-    putStrLn $ JSON.encodePretty bdeps+    liftIO . LB.putStrLn $ JSON.encodePretty bdeps  compileBakeCardRef :: BakeCardReference -> SparkBaker [RawDeployment] compileBakeCardRef (BakeCardCompiled fp) = bakerCompile $ inputCompiled fp

@@ -5,8 +5,7 @@ import Import  import Control.Exception (try)-import System.FilePath-       (isAbsolute, replaceDirectory, takeDirectory)+import System.FilePath (isAbsolute, replaceDirectory, takeDirectory)  import SuperUserSpark.Bake.Types import SuperUserSpark.Compiler.Types@@ -17,11 +16,10 @@ bakeDeployment :: RawDeployment -> SparkBaker BakedDeployment bakeDeployment Deployment {..} = do     d <- bakeDirections deploymentDirections-    pure $-        Deployment {deploymentDirections = d, deploymentKind = deploymentKind}+    pure Deployment {deploymentDirections = d, deploymentKind = deploymentKind} -bakeDirections :: DeploymentDirections FilePath-               -> SparkBaker (DeploymentDirections AbsP)+bakeDirections ::+       DeploymentDirections FilePath -> SparkBaker (DeploymentDirections AbsP) bakeDirections (Directions srcs dst) =     Directions <$> mapM bakeFilePath srcs <*> bakeFilePath dst @@ -37,9 +35,8 @@     env <- asks bakeEnvironment     root <- asks bakeRoot     case complete env fp of-        Left err -> throwError $ BakeError $ err-        Right cp -> do-            if isAbsolute cp+        Left err -> throwError $ BakeError err+        Right cp -> if isAbsolute cp                 then case parseAbsFile cp of                          Left err -> throwError $ BakeError $ show err                          Right af -> pure $ AbsP af@@ -72,17 +69,17 @@   where     go :: FilePath -> [ID]     go [] = []-    go ('$':'(':rest) = (Var id_) : (go next)+    go ('$':'(':rest) = Var id_ : go next       where-        (id_, (')':next)) = break (\c -> c == ')') rest+        (id_, ')':next) = break (== ')') rest     go (s:ss) =         case go ss of-            (Plain str):r -> (Plain (s : str)) : r-            r -> (Plain [s]) : r+            Plain str:r -> Plain (s : str) : r+            r -> Plain [s] : r  replaceId :: Environment -> ID -> Either String FilePath replaceId _ (Plain str) = return str-replaceId e (Var str) = do+replaceId e (Var str) =     case lookup str e of         Nothing ->             Left $

@@ -10,7 +10,7 @@     , checkDeployments     ) where -import Import+import Import hiding (check)  import SuperUserSpark.Bake import SuperUserSpark.Bake.Internal

@@ -7,7 +7,6 @@ import SuperUserSpark.Bake.Types import SuperUserSpark.Check.Types import SuperUserSpark.Compiler.Types-import SuperUserSpark.Constants import SuperUserSpark.CoreTypes import SuperUserSpark.Diagnose.Types @@ -39,7 +38,7 @@ impossibleDeployment _ = False  dirtyDeployment :: DeploymentCheckResult -> Bool-dirtyDeployment (DirtySituation _ _ _) = True+dirtyDeployment DirtySituation{} = True dirtyDeployment _ = False  deploymentReadyToDeploy :: DeploymentCheckResult -> Bool@@ -227,11 +226,11 @@                  then "Deployment is impossible."                  else "Deployment is possible."   where-    output = catMaybes $ map formatDeploymentCheck dss+    output = mapMaybe formatDeploymentCheck dss  formatDeploymentCheck :: (DiagnosedDeployment, DeploymentCheckResult)                       -> Maybe String-formatDeploymentCheck (_, (ReadyToDeploy is)) =+formatDeploymentCheck (_, ReadyToDeploy is) =     Just $ "READY: " ++ formatInstruction is formatDeploymentCheck (_, DeploymentDone) = Nothing formatDeploymentCheck (d, ImpossibleDeployment ds) =@@ -244,7 +243,7 @@         , unlines ds         , "\n"         ]-formatDeploymentCheck (d, (DirtySituation str is c)) =+formatDeploymentCheck (d, DirtySituation str is c) =     Just $     concat         [ "DIRTY: "@@ -262,13 +261,13 @@  formatInstruction :: Instruction -> String formatInstruction (CopyFile from to) =-    unwords $ [toFilePath from, "c->", toFilePath to]+    unwords [toFilePath from, "c->", toFilePath to] formatInstruction (CopyDir from to) =-    unwords $ [toFilePath from, "c->", toFilePath to]+    unwords [toFilePath from, "c->", toFilePath to] formatInstruction (LinkFile from to) =-    unwords $ [toFilePath from, "l->", toFilePath to]+    unwords [toFilePath from, "l->", toFilePath to] formatInstruction (LinkDir from to) =-    unwords $ [toFilePath from, "l->", toFilePath to]+    unwords [toFilePath from, "l->", toFilePath to]  formatCleanupInstruction :: CleanupInstruction -> String formatCleanupInstruction (CleanFile fp) = "remove file " ++ toFilePath fp

@@ -1,5 +1,4 @@ {-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE RecordWildCards #-}  module SuperUserSpark.Check.Types where @@ -15,7 +14,7 @@  instance Validity CheckAssignment -data CheckSettings = CheckSettings+newtype CheckSettings = CheckSettings     { checkDiagnoseSettings :: DiagnoseSettings     } deriving (Show, Eq, Generic) 

@@ -20,6 +20,7 @@ import Control.Exception (try) import Data.Aeson (eitherDecode) import Data.Aeson.Encode.Pretty (encodePretty)+import qualified Data.ByteString.Lazy.Char8 as LB import Data.List (find)  import SuperUserSpark.Compiler.Internal@@ -187,12 +188,12 @@     liftIO $ do         let bs = encodePretty deps         case out of-            Nothing -> putStrLn bs-            Just fp -> writeFile fp bs+            Nothing -> LB.putStrLn bs+            Just fp -> LB.writeFile (toFilePath fp) bs  inputCompiled :: Path Abs File -> ImpureCompiler [RawDeployment] inputCompiled fp = do-    bs <- readFile fp+    bs <- liftIO . LB.readFile $ toFilePath fp     case eitherDecode bs of         Left err ->             throwError $

@@ -20,11 +20,9 @@     defaultKind <- asks compileDefaultKind     localOverride <- gets stateDeploymentKindLocalOverride     superOverride <- asks compileKindOverride-    let resultKind =-            case msum [superOverride, localOverride, kind] of-                Nothing -> defaultKind-                Just k -> k-    outof <- gets stateOutof_prefix+    let resultKind = fromMaybe defaultKind+            $ msum [superOverride, localOverride, kind]+    outof <- gets stateOutofPrefix     into <- gets stateInto     let directions =             Directions@@ -39,14 +37,14 @@         then modify (\s -> s {stateInto = dir})         else modify (\s -> s {stateInto = ip </> dir}) compileDec (OutofDir dir) = do-    op <- gets stateOutof_prefix-    modify (\s -> s {stateOutof_prefix = op ++ [Literal dir]})-compileDec (DeployKindOverride kind) = do+    op <- gets stateOutofPrefix+    modify (\s -> s {stateOutofPrefix = op ++ [Literal dir]})+compileDec (DeployKindOverride kind) =     modify (\s -> s {stateDeploymentKindLocalOverride = Just kind}) compileDec (Block ds) = do     before <- get     compileDecs ds     put before compileDec (Alternatives ds) = do-    op <- gets stateOutof_prefix-    modify (\s -> s {stateOutof_prefix = op ++ [Alts ds]})+    op <- gets stateOutofPrefix+    modify (\s -> s {stateOutofPrefix = op ++ [Alts ds]})

@@ -108,7 +108,7 @@ data CompilerState = CompilerState     { stateDeploymentKindLocalOverride :: Maybe DeploymentKind     , stateInto :: Directory-    , stateOutof_prefix :: CompilerPrefix+    , stateOutofPrefix :: CompilerPrefix     } deriving (Show, Eq, Generic)  instance Validity CompilerState

@@ -11,7 +11,7 @@     CompilerState     { stateDeploymentKindLocalOverride = Nothing     , stateInto = ""-    , stateOutof_prefix = []+    , stateOutofPrefix = []     }  addDeployment :: RawDeployment -> InternalCompiler ()@@ -28,10 +28,10 @@ resolvePrefix [] = [] resolvePrefix [Literal s] = [s] resolvePrefix [Alts ds] = ds-resolvePrefix ((Literal s):ps) = do+resolvePrefix (Literal s:ps) = do     rest <- resolvePrefix ps     return $ s </> rest-resolvePrefix ((Alts as):ps) = do+resolvePrefix (Alts as:ps) = do     a <- as     rest <- resolvePrefix ps     return $ a </> rest

@@ -1,15 +1,11 @@ module SuperUserSpark.Deployer.Internal where -import Import hiding ((</>))+import Import -import Data.Text (pack)-import System.FilePath.Posix-       (dropFileName, dropTrailingPathSeparator)+import System.FilePath.Posix (dropTrailingPathSeparator) import System.Posix.Files (createSymbolicLink, removeLink) -import SuperUserSpark.Bake.Types import SuperUserSpark.Check.Types-import SuperUserSpark.CoreTypes import SuperUserSpark.Deployer.Types import SuperUserSpark.Utils 

@@ -18,6 +18,7 @@ import Import  import qualified Data.Aeson.Encode.Pretty as JSON+import qualified Data.ByteString.Lazy.Char8 as LB  import SuperUserSpark.Bake import SuperUserSpark.Bake.Internal@@ -69,7 +70,7 @@         diagnoserBake $         compileBakeCardRef checkCardReference >>= bakeDeployments     ddeps <- liftIO $ diagnoseDeployments deps-    putStrLn $ JSON.encodePretty ddeps+    liftIO . LB.putStrLn $ JSON.encodePretty ddeps  diagnoserBake :: SparkBaker a -> SparkDiagnoser a diagnoserBake =

@@ -35,23 +35,19 @@     ms <- forgivingAbsence $ getSymbolicLinkStatus fp     case ms of         Nothing -> pure Nonexistent-        Just s ->-            if isBlockDevice s ||-               isCharacterDevice s || isSocket s || isNamedPipe s-                then return IsWeird-                else do-                    if isSymbolicLink s-                        then do-                            point <- readSymbolicLink fp-                            -- TODO check what happens with relative links.-                            apoint <- AbsP <$> parseAbsFile point-                            return $ IsLinkTo apoint-                        else pure $-                             if isDirectory s-                                 then IsDirectory-                                 else if isRegularFile s-                                          then IsFile-                                          else IsWeird+        Just s | isBlockDevice s || isCharacterDevice s || isSocket s || isNamedPipe s+                    -> return IsWeird+               | isSymbolicLink s -> do+                        point <- readSymbolicLink fp+                        -- TODO check what happens with relative links.+                        apoint <- AbsP <$> parseAbsFile point+                        return $ IsLinkTo apoint+               | otherwise -> pure $+                         if isDirectory s+                             then IsDirectory+                             else if isRegularFile s+                                      then IsFile+                                      else IsWeird  -- | Hash a filepath so that two filepaths with the same contents have the same hash hashFilePath :: AbsP -> IO HashDigest@@ -65,7 +61,7 @@         Nonexistent -> return $ HashDigest $ hash ()  hashFile :: AbsP -> IO HashDigest-hashFile fp = (HashDigest . hash) <$> SB.readFile (toPath fp)+hashFile fp = HashDigest . hash <$> SB.readFile (toPath fp)  hashDirectory :: AbsP -> IO HashDigest hashDirectory fp = do

@@ -1,10 +1,11 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}  module SuperUserSpark.Diagnose.Types where -import Import+import Import hiding ((<>))  import Data.Aeson import Data.Hashable@@ -13,6 +14,10 @@ import SuperUserSpark.Bake.Types import SuperUserSpark.Compiler.Types +#if __GLASGOW_HASKELL__ < 840+import Data.Semigroup (Semigroup, (<>))+#endif+ data DiagnoseAssignment = DiagnoseAssignment     { diagnoseCardReference :: BakeCardReference     , diagnoseSettings :: DiagnoseSettings@@ -20,7 +25,7 @@  instance Validity DiagnoseAssignment -data DiagnoseSettings = DiagnoseSettings+newtype DiagnoseSettings = DiagnoseSettings     { diagnoseBakeSettings :: BakeSettings     } deriving (Show, Eq, Generic) @@ -45,14 +50,17 @@  instance Validity HashDigest +instance Semigroup HashDigest where+    HashDigest h1 <> HashDigest h2 = HashDigest $ h1 * 31 + h2+ instance Monoid HashDigest where     mempty = HashDigest (hash ())-    (HashDigest h1) `mappend` (HashDigest h2) = HashDigest $ h1 * 31 + h2+    mappend = (<>)  instance Hashable HashDigest  instance ToJSON HashDigest where-    toJSON (HashDigest i) = toJSON $ (printf "%016x" i :: String)+    toJSON (HashDigest i) = toJSON (printf "%016x" i :: String)  data Diagnostics     = Nonexistent

@@ -15,7 +15,7 @@  instance Validity Dispatch -data ParseArgs = ParseArgs+newtype ParseArgs = ParseArgs     { parseFilePath :: FilePath     } deriving (Show, Eq, Generic) @@ -43,7 +43,7 @@  instance Validity BakeArgs -data BakeFlags = BakeFlags+newtype BakeFlags = BakeFlags     { bakeCompileFlags :: CompileFlags     } deriving (Show, Eq, Generic) @@ -56,7 +56,7 @@  instance Validity DiagnoseArgs -data DiagnoseFlags = DiagnoseFlags+newtype DiagnoseFlags = DiagnoseFlags     { diagnoseBakeFlags :: BakeFlags     } deriving (Show, Eq, Generic) @@ -69,7 +69,7 @@  instance Validity CheckArgs -data CheckFlags = CheckFlags+newtype CheckFlags = CheckFlags     { checkDiagnoseFlags ::DiagnoseFlags     } deriving (Show, Eq, Generic) 

@@ -39,4 +39,4 @@ formatParseError (ParseError pe) = show pe  parseFile :: Path Abs File -> IO (Either ParseError SparkFile)-parseFile file = (left ParseError . parseCardFile file) <$> readFile file+parseFile file = (left ParseError . parseCardFile file) <$> readFile (toFilePath file)

@@ -10,9 +10,7 @@ import Text.Parsec.String  parseCardFile :: Path Abs File -> String -> Either ParseError SparkFile-parseCardFile f s = do-    cs <- parseFromSource sparkFile f s-    return $ SparkFile f cs+parseCardFile f s = SparkFile f <$> parseFromSource sparkFile f s  parseFromSource :: Parser a -> Path Abs File -> String -> Either ParseError a parseFromSource parser file = parse parser $ toFilePath file@@ -36,7 +34,7 @@ card :: Parser Card card = do     whitespace-    skip $ string keywordCard+    void $ string keywordCard     whitespace     name <- cardNameP     whitespace@@ -45,7 +43,7 @@     return $ Card name b  declarations :: Parser [Declaration]-declarations = (inLineSpace declaration) `sepEndBy` delim+declarations = inLineSpace declaration `sepEndBy` delim  declaration :: Parser Declaration declaration =@@ -69,7 +67,7 @@  sparkOff :: Parser Declaration sparkOff =-    do skip $ string keywordSpark+    do void $ string keywordSpark        linespace        ref <- cardReference        return $ SparkOff ref@@ -80,19 +78,19 @@  compiledCardReference :: Parser FilePath compiledCardReference = do-    skip $ string "compiled"-    skip linespace+    void $ string "compiled"+    void linespace     filepath  cardReference :: Parser CardReference cardReference = try goName <|> try goFile <?> "card reference"   where-    goName = cardNameReference >>= return . CardName-    goFile = cardFileReference >>= return . CardFile+    goName = CardName <$> cardNameReference+    goFile = CardFile <$> cardFileReference  cardNameReference :: Parser CardNameReference cardNameReference =-    do skip $ string keywordCard+    do void $ string keywordCard        linespace        name <- cardNameP        return $ CardNameReference name@@ -103,8 +101,8 @@  cardFileReference :: Parser CardFileReference cardFileReference = do-    skip $ string keywordFile-    skip linespace+    void $ string keywordFile+    void linespace     unprefixedCardFileReference  unprefixedCardFileReference :: Parser CardFileReference@@ -120,7 +118,7 @@  intoDir :: Parser Declaration intoDir =-    do skip $ string keywordInto+    do void $ string keywordInto        linespace        dir <- directory        return $ IntoDir dir@@ -128,7 +126,7 @@  outOfDir :: Parser Declaration outOfDir =-    do skip $ string keywordOutof+    do void $ string keywordOutof        linespace        dir <- directory        return $ OutofDir dir@@ -136,7 +134,7 @@  deploymentKindOverride :: Parser Declaration deploymentKindOverride =-    do skip $ string keywordKindOverride+    do void $ string keywordKindOverride        linespace        kind <- try copy <|> link        return $ DeployKindOverride kind@@ -171,7 +169,7 @@  alternatives :: Parser Declaration alternatives = do-    skip $ string keywordAlternatives+    void $ string keywordAlternatives     linespace     ds <- directory `sepBy1` linespace     return $ Alternatives ds@@ -194,19 +192,19 @@ lineComment :: Parser String lineComment =     (<?> "Line comment") $ do-        skip $ try $ string lineCommentStr+        void $ try $ string lineCommentStr         anyChar `manyTill` eol  blockComment :: Parser String blockComment =     (<?> "Block comment") $ do-        skip $ try $ string start-        anyChar `manyTill` (try $ string stop)+        void $ try $ string start+        anyChar `manyTill` try (string stop)   where     (start, stop) = blockCommentStrs  notComment :: Parser String-notComment = manyTill anyChar (lookAhead ((skip comment) <|> eof))+notComment = manyTill anyChar (lookAhead (void comment <|> eof))  eatComments :: Parser String eatComments = do@@ -236,7 +234,7 @@ inQuotes = between (char quotesChar) (char quotesChar)  delim :: Parser ()-delim = try (skip $ string lineDelimiter) <|> go+delim = try (void $ string lineDelimiter) <|> go   where     go = do         eol@@ -250,18 +248,14 @@ inWhiteSpace = between whitespace whitespace  linespace :: Parser ()-linespace = skip $ many $ oneOf linespaceChars+linespace = void $ many $ oneOf linespaceChars  whitespace :: Parser ()-whitespace = skip $ many $ oneOf whitespaceChars+whitespace = void $ many $ oneOf whitespaceChars  eol :: Parser ()-eol = skip newline_+eol = void newline_   where     newline_ =         try (string "\r\n") <|> try (string "\n") <|>         string "\r" <?> "end of line"----[ Utils ]---skip :: Parser a -> Parser ()-skip p = p >> return ()

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-}  module SuperUserSpark.Parser.Types where@@ -7,7 +6,7 @@  import qualified Text.Parsec as Parsec -data ParseAssignment = ParseAssignment+newtype ParseAssignment = ParseAssignment     { fileToParse :: Path Abs File     } deriving (Show, Eq, Generic) @@ -24,4 +23,4 @@     deriving (Show, Eq, Generic)  instance Validity ParseError where-    isValid (ParseError _) = True+    validate = trivialValidation

@@ -6,7 +6,6 @@ import Import  import Data.List (isInfixOf)-import qualified System.Directory as D (createDirectoryIfMissing)  incase     :: MonadReader c m

@@ -1,5 +1,5 @@ name:                super-user-spark-version:             0.4.0.0+version:             0.4.0.1 license:             MIT license-file:        LICENSE description:         Configure your dotfile deployment with a DSL.@@ -54,23 +54,22 @@    build-depends:            base                  >= 4.9   && < 5-      , aeson                 >= 0.11  && < 1.2-      , aeson-pretty          >= 0.8   && < 0.9-      , bytestring            >= 0.10  && < 0.11-      , directory             >= 1.3   && < 1.4-      , filepath              >= 1.4   && < 1.5-      , mtl                   >= 2.2   && < 2.3-      , optparse-applicative  >= 0.13  && < 0.14-      , parsec                >= 3.1.9 && < 3.2-      , process               >= 1.4   && < 1.6-      , hashable              >= 1.2   && < 1.3-      , text                  >= 1.2   && < 1.3-      , unix                  >= 2.7   && < 2.8-      , validity              >= 0.3.2 && < 0.4-      , validity-path >= 0.1 && < 0.2-      , path >= 0.5 && < 0.6-      , path-io >= 1.2 && < 1.3-      , iostring >= 0.0 && < 0.1+      , aeson+      , aeson-pretty+      , bytestring+      , directory+      , filepath+      , mtl+      , optparse-applicative+      , parsec+      , process+      , hashable+      , text+      , unix+      , validity              >= 0.6.0.0+      , validity-path+      , path+      , path-io   default-language: Haskell2010   default-extensions: NoImplicitPrelude @@ -122,8 +121,7 @@       , super-user-spark       , hspec                 >= 2.2   && < 2.5       , hspec-core            >= 2.2   && < 2.5-      , HUnit                 >= 1.2   && < 1.6-      , QuickCheck            >= 2.8   && < 2.10+      , QuickCheck       , aeson                        , aeson-pretty                 , bytestring            @@ -136,15 +134,14 @@       , text                         , transformers                 , unix                  -      , genvalidity >= 0.3.1 && < 0.4-      , genvalidity-path >= 0.1 && < 0.2-      , genvalidity-hspec >= 0.3.1 && < 0.4-      , genvalidity-hspec-aeson >= 0.0 && < 0.1+      , genvalidity+      , genvalidity-path+      , genvalidity-hspec+      , genvalidity-hspec-aeson       , validity       , validity-path       , path       , path-io-      , iostring       , hashable   default-language:  Haskell2010   default-extensions: NoImplicitPrelude

@@ -84,7 +84,7 @@                         let to = $(mkRelDir "to") </> file                         withCurrentDir sandbox $ do                             ensureDir $ parent $ sandbox </> from-                            writeFile (sandbox </> from) "contents"+                            writeFile (toFilePath $ sandbox </> from) "contents"                             ensureDir $ parent $ sandbox </> to                             createSymbolicLink                                 (toFilePath $ sandbox </> from)@@ -93,7 +93,9 @@                                 runReaderT                                     (runExceptT f)                                     (defaultBakeSettings-                                     {bakeRoot = sandbox, bakeEnvironment = []})+                                    { bakeRoot = sandbox+                                    , bakeEnvironment = []+                                    })                         runBake (bakeFilePath (toFilePath to)) `shouldReturn`                             (Right $ AbsP $ sandbox </> to)                         runBake (bakeFilePath (toFilePath from)) `shouldReturn`@@ -107,19 +109,25 @@                         let to = todir </> file                         withCurrentDir sandbox $ do                             ensureDir $ parent $ sandbox </> from-                            writeFile (sandbox </> from) "from contents"+                            writeFile+                                (toFilePath $ sandbox </> from)+                                "from contents"                             ensureDir $ parent $ sandbox </> todir                             createSymbolicLink                                 (FP.dropTrailingPathSeparator $                                  toFilePath $ sandbox </> fromdir)                                 (FP.dropTrailingPathSeparator $                                  toFilePath $ sandbox </> todir)-                            writeFile (sandbox </> to) "to contents"+                            writeFile+                                (toFilePath $ sandbox </> to)+                                "to contents"                         let runBake f =                                 runReaderT                                     (runExceptT f)                                     (defaultBakeSettings-                                     {bakeRoot = sandbox, bakeEnvironment = []})+                                    { bakeRoot = sandbox+                                    , bakeEnvironment = []+                                    })                         runBake (bakeFilePath (toFilePath to)) `shouldReturn`                             (Right $ AbsP $ sandbox </> from)                         runBake (bakeFilePath (toFilePath from)) `shouldReturn`

@@ -1,5 +1,3 @@-{-# LANGUAGE TemplateHaskell #-}- module SuperUserSpark.Check.TestUtils where  import TestImport@@ -22,7 +20,7 @@  -- * Test utils for checkSingle isDirty :: CheckResult -> Bool-isDirty (Dirty _ _ _) = True+isDirty Dirty{}  = True isDirty _ = False  isReady :: CheckResult -> Bool@@ -48,23 +46,15 @@         Dirty _ ins ci -> do             ci `shouldBe` eci             let tp = dropTrailingPathSeparator . toFilePath-            case ins of-                CopyFile isrc idst -> do-                    tp isrc `shouldBe` toPath (diagnosedFilePath src)-                    tp idst `shouldBe` toPath (diagnosedFilePath dst)-                    CopyDeployment `shouldBe` kind-                CopyDir isrc idst -> do-                    tp isrc `shouldBe` toPath (diagnosedFilePath src)-                    tp idst `shouldBe` toPath (diagnosedFilePath dst)-                    CopyDeployment `shouldBe` kind-                LinkFile isrc idst -> do-                    tp isrc `shouldBe` toPath (diagnosedFilePath src)-                    tp idst `shouldBe` toPath (diagnosedFilePath dst)-                    LinkDeployment `shouldBe` kind-                LinkDir isrc idst -> do+            let checkCopyDeployment isrc idst expectation = do                     tp isrc `shouldBe` toPath (diagnosedFilePath src)                     tp idst `shouldBe` toPath (diagnosedFilePath dst)-                    LinkDeployment `shouldBe` kind+                    expectation `shouldBe` kind+            case ins of+                CopyFile isrc idst -> checkCopyDeployment isrc idst CopyDeployment+                CopyDir isrc idst -> checkCopyDeployment isrc idst CopyDeployment+                LinkFile isrc idst -> checkCopyDeployment isrc idst LinkDeployment+                LinkDir isrc idst -> checkCopyDeployment isrc idst LinkDeployment         t ->             expectationFailure $             unlines

@@ -13,18 +13,15 @@ instance GenValid CompileAssignment where     genValid = CompileAssignment <$> genValid <*> genValid <*> genValid - instance GenUnchecked StrongCardFileReference  instance GenValid StrongCardFileReference - instance GenUnchecked CompileSettings  instance GenValid CompileSettings where     genValid = CompileSettings <$> genValid <*> genValid - instance GenUnchecked a =>          GenUnchecked (Deployment a) where     genUnchecked = Deployment <$> genUnchecked <*> genUnchecked@@ -44,7 +41,6 @@  instance GenValid PrefixPart - instance GenUnchecked CompilerState  instance GenValid CompilerState@@ -55,6 +51,6 @@             [ PreCompileErrors <$> genUnchecked             , DuringCompilationError <$> genUnchecked             ]+    shrinkUnchecked _ = []  instance GenValid CompileError-

@@ -92,4 +92,4 @@  -- Filepath utils containsNewlineCharacter :: String -> Bool-containsNewlineCharacter f = any (\c -> elem c f) ['\n', '\r']+containsNewlineCharacter f = any (`elem` f) ['\n', '\r']

@@ -3,7 +3,7 @@  module SuperUserSpark.CompilerSpec where -import TestImport+import TestImport hiding ((<.>))  import Data.Either (isLeft, isRight) import Data.List (isPrefixOf)@@ -192,7 +192,7 @@     CompilerState     { stateDeploymentKindLocalOverride = Nothing     , stateInto = ""-    , stateOutof_prefix = []+    , stateOutofPrefix = []     }  instanceSpec :: Spec@@ -270,7 +270,7 @@             it "adds the given directory to the outof state" $ do                 forAll validFp $ \fp ->                     shouldState (OutofDir fp) $-                    s {stateOutof_prefix = [Literal fp]}+                    s {stateOutofPrefix = [Literal fp]}             pend         describe "DeployKindOverride" $ do             it "modifies the internal deployment kind override" $ do@@ -287,7 +287,7 @@                 "adds an alternatives prefix to the outof prefix in the compiler state" $ do                 forAll (listOf validFilePath) $ \fps ->                     shouldState (Alternatives fps) $-                    s {stateOutof_prefix = [Alts fps]}+                    s {stateOutofPrefix = [Alts fps]}             pend  runDefaultImpureCompiler :: ImpureCompiler a -> IO (Either CompileError a)

@@ -67,7 +67,7 @@                     withCurrentDir sandbox $ do                         let file = sandbox </> $(mkRelFile "test.txt")                         let fp = AbsP file-                        writeFile file "This is a test"+                        writeFile (toFilePath file) "This is a test"                         diagnoseFp fp `shouldReturn` IsFile                         clean c $ CleanFile file                         diagnoseFp fp `shouldReturn` IsFile@@ -80,7 +80,7 @@                     withCurrentDir sandbox $ do                         let file = sandbox </> $(mkRelFile "test.txt")                         let fp = AbsP file-                        writeFile file "This is a test"+                        writeFile (toFilePath file) "This is a test"                         diagnoseFp fp `shouldReturn` IsFile                         clean c $ CleanFile file                         diagnoseFp fp `shouldReturn` Nonexistent@@ -119,7 +119,7 @@                         let link_' = AbsP link_                         let file_ = sandbox </> $(mkRelFile "testfile")                         let file_' = AbsP file_-                        writeFile file_ "This is a test"+                        writeFile (toFilePath file_) "This is a test"                         createSymbolicLink (toFilePath file_) (toFilePath link_)                         diagnoseFp link_' `shouldReturn` IsLinkTo file_'                         clean c $ CleanLink link_@@ -138,7 +138,7 @@                         let link_' = AbsP link_                         let file_ = sandbox </> $(mkRelFile "testfile")                         let file_' = AbsP file_-                        writeFile file_ "This is a test"+                        writeFile (toFilePath file_) "This is a test"                         createSymbolicLink (toFilePath file_) (toFilePath link_)                         diagnoseFp link_' `shouldReturn` IsLinkTo file_'                         clean c $ CleanLink link_@@ -178,7 +178,7 @@                         let src' = AbsP src                         let dst = sandbox </> $(mkRelFile "testcopy")                         let dst' = AbsP dst-                        writeFile src "This is a file."+                        writeFile (toFilePath src) "This is a file."                         diagnoseFp src' `shouldReturn` IsFile                         diagnoseFp dst' `shouldReturn` Nonexistent                         -- Under test@@ -224,7 +224,7 @@                         let dst' = AbsP dst                         diagnoseFp src' `shouldReturn` Nonexistent                         diagnoseFp dst' `shouldReturn` Nonexistent-                        writeFile src "This is a test."+                        writeFile (toFilePath src) "This is a test."                         diagnoseFp src' `shouldReturn` IsFile                         diagnoseFp dst' `shouldReturn` Nonexistent                         -- Under test

@@ -1,5 +1,3 @@-{-# LANGUAGE TemplateHaskell #-}- module SuperUserSpark.Diagnose.TestUtils where  import TestImport

@@ -99,7 +99,7 @@                     let link = sandbox </> $(mkRelFile "link")                     let link' = AbsP link                     expect "before" [(file', Nonexistent), (link', Nonexistent)]-                    writeFile file "This is a test"+                    writeFile (toFilePath file) "This is a test"                     expect                         "after file creation"                         [(file', IsFile), (link', Nonexistent)]@@ -137,7 +137,7 @@                     forAll (absFileIn sandbox) $ \(file, file') -> do                         diagnoseFp file' `shouldReturn` Nonexistent                         ensureDir $ parent file-                        writeFile file "This is a test"+                        writeFile (toFilePath file) "This is a test"                         diagnoseFp file' `shouldReturn` IsFile                         removeFile file                         diagnoseFp file' `shouldReturn` Nonexistent@@ -154,7 +154,7 @@                             expect                                 "before"                                 [(file', Nonexistent), (link', Nonexistent)]-                            writeFile file "This is a test"+                            writeFile (toFilePath file) "This is a test"                             expect                                 "after file creation"                                 [(file', IsFile), (link', Nonexistent)]@@ -257,7 +257,8 @@     let setupALotOfFiles = do             forM_ [1 .. aLot] $ \i -> do                 f <- parseRelFile $ "file" ++ show i-                writeFile (sandbox </> f) $ "This is file " ++ show i ++ ".\n"+                writeFile (toFilePath $ sandbox </> f) $+                    "This is file " ++ show i ++ ".\n"     beforeAll_ setup $         afterAll_ teardown $ do             describe "hashFilePath" $ do

@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE LambdaCase #-}  module SuperUserSpark.EndToEnd.RegressionSpec     ( spec@@ -15,8 +16,7 @@ import SuperUserSpark.Utils  spec :: Spec-spec = do-    linkThenCopySpec+spec = linkThenCopySpec  linkThenCopySpec :: Spec linkThenCopySpec = do@@ -25,40 +25,39 @@     let setup = ensureDir sandbox     let teardown = removeDirRecur sandbox     beforeAll_ setup $-        afterAll_ teardown $ do-            describe "link then copy regression" $ do-                let runSpark args = do-                        putStrLn $ unwords $ "spark" : args-                        withArgs args spark-                it-                    "ensures that deploy fails when there is already a link that points to the file that is being copied." $-                    withCurrentDir sandbox $ do-                        let cf = sandbox </> $(mkRelFile "cardfile.sus")-                        let file = $(mkRelFile "file")-                        let from = sandbox </> $(mkRelDir "from") </> file-                        let to = sandbox </> $(mkRelDir "to") </> file+        afterAll_ teardown $+        describe "link then copy regression" $ do+            let runSpark args = do+                    putStrLn . unwords $ "spark" : args+                    withArgs args spark+            it+                "ensures that deploy fails when there is already a link that points to the file that is being copied." $+                withCurrentDir sandbox $ do+                    let cf = sandbox </> $(mkRelFile "cardfile.sus")+                    let file = $(mkRelFile "file")+                    let from = sandbox </> $(mkRelDir "from") </> file+                    let to = sandbox </> $(mkRelDir "to") </> file                         -- Set up the file-                        ensureDir (parent from)-                        writeFile from "contents"+                    ensureDir (parent from)+                    writeFile (toFilePath from) "contents"+                    let setUpCardFile cf = do+                            runSpark ["parse", toFilePath cf]+                            runSpark ["compile", toFilePath cf]+                            runSpark ["bake", toFilePath cf]+                            runSpark ["check", toFilePath cf]+                    writeFile (toFilePath from) "contents"                         -- Set up the first card file-                        writeFile-                            cf-                            "card link { kind link; into to; outof from; file }"-                        runSpark ["parse", toFilePath cf]-                        runSpark ["compile", toFilePath cf]-                        runSpark ["bake", toFilePath cf]-                        runSpark ["check", toFilePath cf]-                        runSpark ["deploy", toFilePath cf]+                    writeFile+                        (toFilePath cf)+                        "card link { kind link; into to; outof from; file }"+                    setUpCardFile cf+                    runSpark ["deploy", toFilePath cf]                         -- Set up the second card file-                        writeFile-                            cf-                            "card link { kind copy; into to; outof from; file }"-                        runSpark ["parse", toFilePath cf]-                        runSpark ["compile", toFilePath cf]-                        runSpark ["bake", toFilePath cf]-                        runSpark ["check", toFilePath cf]-                        runSpark ["deploy", toFilePath cf] `shouldThrow`-                            (\e ->-                                 case e of-                                     ExitFailure _ -> True-                                     _ -> False)+                    writeFile+                        (toFilePath cf)+                        "card link { kind copy; into to; outof from; file }"+                    setUpCardFile cf+                    runSpark ["deploy", toFilePath cf] `shouldThrow`+                        (\case+                             ExitFailure _ -> True+                             _ -> False)

@@ -33,7 +33,7 @@     let teardown = removeDirectoryRecursive sandbox     let rsc = here </> "test_resources" </> "end-to-end"     beforeAll_ setup $-        afterAll_ teardown $ do+        afterAll_ teardown $             describe "standard bash card test" $ do                 let bashrsc = rsc </> "bash.sus"                 let bashrscres = rsc </> "bash.sus.res"@@ -48,11 +48,11 @@                                 P.writeFile "bash_profile" "bash_profile"                 let down = do                         removeFile cardfile-                        withCurrentDirectory sandbox $ do+                        withCurrentDirectory sandbox $                             removeDirectoryRecursive "bash"                 beforeAll_ up $                     afterAll_ down $ do-                        it "parses correcty" $ do+                        it "parses correcty" $                             withCurrentDirectory sandbox $                                 withArgs ["parse", cardfile] spark `shouldReturn`                                 ()@@ -66,7 +66,7 @@                             actual <- P.readFile outfile                             expected <- P.readFile bashrscres                             unless (actual == expected) $ expectationFailure $ unlines ["Expected and actual differ:", expected, actual]-                        it "checks without exceptions" $ do+                        it "checks without exceptions" $                             withCurrentDirectory sandbox $                                 withArgs ["check", cardfile] spark `shouldReturn`                                 ()

@@ -32,7 +32,7 @@     oneof [generateTab, generateSpace, generateLineFeed, generateCarriageReturn]  generateWords :: Gen String-generateWords = fmap unwords $ listOf1 generateWord+generateWords = unwords <$> listOf1 generateWord  generateEol :: Gen String generateEol = elements ["\n", "\r", "\r\n"]@@ -52,12 +52,12 @@ generateQuotedIdentifier :: Gen (String, String) generateQuotedIdentifier = do     w <- generateWord-    return $ ("\"" ++ w ++ "\"", w)+    return ("\"" ++ w ++ "\"", w)  generatePlainIdentifier :: Gen (String, String) generatePlainIdentifier = do     w <- generateWord-    return $ (w, w)+    return (w, w)  generateFilePath :: Gen (FilePath, FilePath) generateFilePath =

@@ -26,7 +26,7 @@ succeedsWithLeftover parser input = isRight $ parseWithoutSource parser input  succeedsAnywhere :: Parser a -> String -> Bool-succeedsAnywhere p s = or $ map (succeedsWithLeftover p) (tails s)+succeedsAnywhere p s = any (succeedsWithLeftover p) $ tails s   where     tails :: [a] -> [[a]]     tails [] = [[]]@@ -51,4 +51,4 @@     parseFromSource parser testInputSource input `shouldBe` result  parseWithoutSource :: Parser a -> String -> Either ParseError a-parseWithoutSource parser input = parseFromSource parser testInputSource input+parseWithoutSource parser = parseFromSource parser testInputSource

@@ -288,30 +288,30 @@         let pc = parseShouldSucceedAs card         it "succeeds on this card with an empty name correctly" $ do             pc "card \"\" {}" $ Card "" (Block [])-        it "succeeds on this compressed empty cards" $ do+        it "succeeds on this compressed empty cards" $             forAll generateCardName $ \(a, e) ->                 parseShouldSucceedAs card ("card" ++ a ++ "{}") $                 Card e (Block [])-        it "succeeds on empty cards with whitespace around the name" $ do+        it "succeeds on empty cards with whitespace around the name" $             forAll generateCardName $ \(a, e) ->                 forAll (twice generateWhiteSpace) $ \(ws1, ws2) ->                     parseShouldSucceedAs                         card                         ("card" ++ ws1 ++ a ++ ws2 ++ "{}") $                     Card e (Block [])-        it "succeeds on empty cards with whitespace between the brackets" $ do+        it "succeeds on empty cards with whitespace between the brackets" $             forAll generateCardName $ \(a, e) ->                 forAll generateWhiteSpace $ \ws ->                     parseShouldSucceedAs card ("card" ++ a ++ "{" ++ ws ++ "}") $                     Card e (Block [])-        it "fails on any card with an empty body" $ do+        it "fails on any card with an empty body" $             forAll generateCardName $ \(a, _) ->                 forAll generateWhiteSpace $ \ws ->                     shouldFail card ("card" ++ a ++ ws)-        it "succeeds on this complicated example" $ do+        it "succeeds on this complicated example" $             parseShouldSucceedAs                 card-                ("card complicated {\n  alternatives $(HOST) shared\n  hello l-> goodbye\n into $(HOME)\n  outof depot\n  spark card othercard\n  kind link\n  {\n    one c-> more\n    source -> destination\n    file\n  }\n}") $+                "card complicated {\n  alternatives $(HOST) shared\n  hello l-> goodbye\n into $(HOME)\n  outof depot\n  spark card othercard\n  kind link\n  {\n    one c-> more\n    source -> destination\n    file\n  }\n}" $                 Card "complicated" $                 Block                     [ Alternatives ["$(HOST)", "shared"]@@ -327,12 +327,12 @@                           ]                     ]     describe "declarations" $ do-        it "succeeds for generated declarations'" $ do pending+        it "succeeds for generated declarations'" pending         let s = parseShouldSucceedAs declarations-        it "succeeds for these cases" $ do+        it "succeeds for these cases" $             s "into dir;outof dir" [IntoDir "dir", OutofDir "dir"]     describe "declaration" $ do-        it "succeeds for generated declarations" $ do pending+        it "succeeds for generated declarations" pending         let s = parseShouldSucceedAs declaration         it "succeeds for these cases" $ do             s "into directory" (IntoDir "directory")@@ -346,11 +346,11 @@                      "iamthedestination"                      (Just CopyDeployment))     describe "block" $ do-        it "succeeds for empty blocks" $ do+        it "succeeds for empty blocks" $             parseShouldSucceedAs block "{}" (Block [])-        it "succeeds for a doubly nested empty block" $ do+        it "succeeds for a doubly nested empty block" $             parseShouldSucceedAs block "{{}}" (Block [Block []])-        it "succeeds for a triply nested empty block" $ do+        it "succeeds for a triply nested empty block" $             parseShouldSucceedAs block "{{{}}}" (Block [Block [Block []]])         let s = parseShouldSucceedAs block         it "succeeds for these cases" $ do@@ -361,7 +361,7 @@                 "{\n    into \"~\"\n    \"xmonad\" -> \".xmonad\"\n}"                 (Block [IntoDir "~", Deploy "xmonad" ".xmonad" Nothing])     describe "sparkOff" $ do-        it "succeeds for generated sparkOff declarations" $ do pending+        it "succeeds for generated sparkOff declarations" pending         let s f g =                 parseShouldSucceedAs                     sparkOff@@ -372,7 +372,7 @@             s "sparkcardname" "name"             s "spark card \"name with spaces\"" "name with spaces"     describe "intoDir" $ do-        it "succeeds for generated into declarations" $ do+        it "succeeds for generated into declarations" $             forAll generateLineSpace $ \ls ->                 forAll generateDirectory $ \(d, da) ->                     parseShouldSucceedAs@@ -385,7 +385,7 @@             s "into\t.xmonad" ".xmonad"             s "into ~" "~"     describe "outOfDir" $ do-        it "succeeds for generated outof declarations" $ do+        it "succeeds for generated outof declarations" $             forAll generateLineSpace $ \ls ->                 forAll generateDirectory $ \(d, da) ->                     parseShouldSucceedAs@@ -396,30 +396,28 @@         it "succeeds for these cases" $ do             s "outof bash" "bash"             s "outof\t.xmonad" ".xmonad"-    describe "alternatives" $ do-        it "succeeds for generated alternatives declarations with single spaces" $ do+    describe "alternatives" $+        it "succeeds for generated alternatives declarations with single spaces" $             forAll (listOf1 generateDirectory) $ \ds ->                 let (des, das) = unzip ds                 in parseShouldSucceedAs                        alternatives-                       ("alternatives" ++ " " ++ intercalate " " des)+                       ("alternatives" ++ " " ++ unwords des)                        (Alternatives das)     describe "deployment" $ do         it "succeeds for short deployments" pending         it "succeeds for long deployments" pending     describe "shortDeployment" $ do-        it "succeeds for any filepath with an identity deployment" $ do-            property $ \f ->-                succeeds filepath f ==>+        it "succeeds for any filepath with an identity deployment" $+            property $ \f -> succeeds filepath f ==>                 parseShouldSucceedAs shortDeployment f (Deploy f f Nothing)-        it "succeeds for generated filepaths with an identity deployment" $ do+        it "succeeds for generated filepaths with an identity deployment" $             forAll generateFilePath $ \(f, g) ->                 parseShouldSucceedAs shortDeployment f (Deploy g g Nothing)-        it "succeeds for any directory with an identity deployment" $ do-            property $ \f ->-                succeeds directory f ==>+        it "succeeds for any directory with an identity deployment" $+            property $ \f -> succeeds directory f ==>                 parseShouldSucceedAs shortDeployment f (Deploy f f Nothing)-        it "succeeds for generated directories with an identity deployment" $ do+        it "succeeds for generated directories with an identity deployment" $             forAll generateDirectory $ \(f, g) ->                 parseShouldSucceedAs shortDeployment f (Deploy g g Nothing)         let s f = parseShouldSucceedAs shortDeployment f (Deploy f f Nothing)@@ -428,7 +426,7 @@             s "xmonad.hs"             s "/home/user/.bashrc"     describe "longDeployment" $ do-        it "succeeds for generated long deployments with quoted identifiers" $ do+        it "succeeds for generated long deployments with quoted identifiers" $             forAll generateDeploymentKindSymbol $ \dks ->                 forAll generateLineSpace $ \ls1 ->                     forAll generateLineSpace $ \ls2 ->@@ -444,7 +442,7 @@                                             (fp1 ++ ls1 ++ dks ++ ls2 ++ fp2)                                             (Deploy fp1a fp2a dk)         it-            "succeeds for single-space-separated long deployments with gerenated plain identifiers" $ do+            "succeeds for single-space-separated long deployments with gerenated plain identifiers" $             pendingWith                 "This would go wrong with plain identifiers they can end with \'l\' or \'c\'. Make sure to document this behaviour and write another test with plain identifiers."         let s f g h i = parseShouldSucceedAs longDeployment f (Deploy g h i)@@ -466,22 +464,21 @@                 Nothing     describe "deploymentKind" $ do         let (-=>) = parseShouldSucceedAs deploymentKind-        it "succeeds for the link deployment kind" $ do+        it "succeeds for the link deployment kind" $             "l->" -=> Just LinkDeployment-        it "succeeds for the copy deployment kind" $ do+        it "succeeds for the copy deployment kind" $             "c->" -=> Just CopyDeployment-        it "succeeds for the default deployment kind" $ do "->" -=> Nothing-        it "fails for anything else" $ do-            property $ \s ->-                (not $ any (== s) ["l->", "c->", "->"]) ==>+        it "succeeds for the default deployment kind" $ "->" -=> Nothing+        it "fails for anything else" $ property $ \s ->+            notElem s ["l->", "c->", "->"] ==>                 shouldFail deploymentKind s  cardReferenceParserTests :: Spec cardReferenceParserTests = do-    describe "compilerCardReference" $ do pend-    describe "deployerCardReference" $ do pend-    describe "compiledCardReference" $ do pend-    describe "cardReference" $ do pend+    describe "compilerCardReference" pend+    describe "deployerCardReference" pend+    describe "compiledCardReference" pend+    describe "cardReference" pend     describe "cardNameReference" $ do         pend         let s f g =@@ -498,7 +495,7 @@             s                 "file card.sus name"                 (CardFileReference "card.sus" $ Just $ CardNameReference "name")-    describe "unprefixedCardFileReference" $ do pend+    describe "unprefixedCardFileReference" pend  parserBlackBoxTests :: Spec parserBlackBoxTests = do@@ -509,15 +506,13 @@                     (testRecoursesDir </>)                     [shouldParseDir, shouldCompileDir, shouldNotCompileDir]         forFileInDirss dirs $-            concerningContents $ \f contents -> do-                it (toFilePath f) $-                    parseCardFile f contents `shouldSatisfy` isRight+            concerningContents $ \f contents -> it (toFilePath f) $+                parseCardFile f contents `shouldSatisfy` isRight     describe "Correct unsuccesfull parse examples" $ do         let dirs = map (testRecoursesDir </>) [shouldNotParseDir]-        forFileInDirss dirs $-            concerningContents $ \f contents -> do+        forFileInDirss dirs $ concerningContents $ \f contents ->                 it (toFilePath f) $-                    parseCardFile f contents `shouldSatisfy` isLeft+                parseCardFile f contents `shouldSatisfy` isLeft  toplevelParserTests :: Spec toplevelParserTests = do@@ -525,4 +520,4 @@         it "Only ever produces valid SparkFile's" $             validIfSucceeds2 parseCardFile         pend-    describe "resetPosition" $ do pend+    describe "resetPosition" pend

@@ -2,7 +2,7 @@     ( module X     ) where -import Prelude as X hiding (writeFile, readFile, putStr,putStrLn, appendFile)+import Prelude as X  import Path as X import Path.IO as X@@ -16,8 +16,6 @@ import Control.Monad.Writer as X  import Debug.Trace as X--import Data.IOString as X  import Test.Hspec as X import Test.QuickCheck as X

@@ -18,7 +18,7 @@  concerningContents :: (Path Abs File -> String -> SpecWith a)                    -> (Path Abs File -> SpecWith a)-concerningContents func file = (runIO $ readFile file) >>= func file+concerningContents func file = (runIO . readFile $ toFilePath file) >>= func file  forFileInDirss :: [Path Abs Dir] -> (Path Abs File -> SpecWith a) -> SpecWith a forFileInDirss [] _ = return ()