super-user-spark 0.3.0.0 → 0.3.1.0
raw patch · 21 files changed
+233/−576 lines, 21 filesdep ~HUnitdep ~QuickCheckdep ~aeson
Dependency ranges changed: HUnit, QuickCheck, aeson, aeson-pretty, base, bytestring, directory, filepath, hspec, hspec-core, mtl, optparse-applicative, parsec, process, pureMD5, shelly, text, transformers, unix
Files
- README.md +27/−1
- src/Arguments.hs +23/−70
- src/Check/Internal.hs +4/−4
- src/Compiler.hs +9/−16
- src/Compiler/Internal.hs +6/−6
- src/Compiler/Types.hs +16/−13
- src/Compiler/Utils.hs +5/−5
- src/Config.hs +2/−8
- src/Config/Types.hs +8/−34
- src/Deployer/Internal.hs +4/−3
- src/Deployer/Types.hs +16/−13
- src/Dispatch.hs +0/−6
- src/Dispatch/Types.hs +5/−5
- src/Formatter.hs +0/−276
- src/Language/Types.hs +9/−7
- src/Monad.hs +0/−2
- src/Parser/Internal.hs +3/−4
- src/Types.hs +2/−22
- super-user-spark.cabal +82/−77
- test/CompilerSpec.hs +1/−4
- test/EndToEndSpec.hs +11/−0
README.md view
@@ -1,7 +1,33 @@ # Super User Spark [](https://travis-ci.org/NorfairKing/super-user-spark) -A safe way to never worry about your beautifully configured system again+A safe way to never worry about your beautifully configured system again.++## Example++If your dotfiles repository looks like this...++```+dotfiles+├── bashrc+├── bash_aliases+├── bash_profile+└── README+```++... then you can now deploy those dotfiles with this `.sus` file using `spark`!++``` super-user-spark+card bash {+ into ~++ .bashrc+ .bash_aliases+ .bash_profile+}+```++Find out more in the documentation below. ## Documentation Most of the documentation is in the `doc` directory.
src/Arguments.hs view
@@ -22,20 +22,14 @@ configFromOptions :: GlobalOptions -> Either String SparkConfig configFromOptions go = Right conf where- conf = defaultConfig {- conf_format_lineUp = if opt_compress go then False else opt_lineUp go- , conf_format_indent = if opt_compress go then 0 else opt_indent go- , conf_format_trailingNewline = if opt_compress go then False else opt_trailingNewline go- , conf_format_alwaysQuote = if opt_compress go then False else opt_alwaysQuote go- , conf_format_oneLine = opt_compress go- , conf_compile_output = opt_output go- , conf_compile_format = opt_format go- , conf_compile_kind = opt_kind go- , conf_compile_override = opt_overrride go- , conf_deploy_replace_links = opt_replace_links go || opt_replace go- , conf_deploy_replace_files = opt_replace_files go || opt_replace go- , conf_deploy_replace_directories = opt_replace_directories go || opt_replace go- , conf_debug = opt_debug go+ conf = defaultConfig+ { conf_compile_output = opt_output go+ , conf_compile_kind = opt_kind go+ , conf_compile_override = opt_overrride go+ , conf_deploy_replace_links = opt_replace_links go || opt_replace go+ , conf_deploy_replace_files = opt_replace_files go || opt_replace go+ , conf_deploy_replace_directories = opt_replace_directories go || opt_replace go+ , conf_debug = opt_debug go } getOptions :: IO Options@@ -46,13 +40,14 @@ runOptionsParser :: [String] -> ParserResult Options runOptionsParser strs = execParserPure prefs optionsParser strs- where prefs = ParserPrefs {- prefMultiSuffix = "SPARK" -- metavar suffix for multiple options- , prefDisambiguate = True -- automatically disambiguate abbreviations (default: False)- , prefShowHelpOnError = True -- always show help text on parse errors (default: False)- , prefBacktrack = True -- backtrack to parent parser when a subcommand fails (default: True)- , prefColumns = 80 -- number of columns in the terminal, used to format the help page (default: 80)- }+ where+ prefs = ParserPrefs+ { prefMultiSuffix = "SPARK" -- metavar suffix for multiple options+ , prefDisambiguate = True -- automatically disambiguate abbreviations (default: False)+ , prefShowHelpOnError = True -- always show help text on parse errors (default: False)+ , prefBacktrack = True -- backtrack to parent parser when a subcommand fails (default: True)+ , prefColumns = 80 -- number of columns in the terminal, used to format the help page (default: 80)+ } optionsParser :: ParserInfo Options optionsParser = info (helper <*> parseOptions) help@@ -65,9 +60,7 @@ parseCommand :: Parser Dispatch parseCommand = hsubparser $ mconcat- [- command "parse" parseParse- , command "format" parseFormat+ [ command "parse" parseParse , command "compile" parseCompile , command "check" parseCheck , command "deploy" parseDeploy@@ -80,13 +73,6 @@ modifier = fullDesc <> progDesc "Parse a spark file and check for syntactic errors." -parseFormat :: ParserInfo Dispatch-parseFormat = info parser modifier- where- parser = DispatchFormat <$> strArgument (metavar "FILE" <> help "the file to format")- modifier = fullDesc- <> progDesc "Format a spark file."- parseCompile :: ParserInfo Dispatch parseCompile = info parser modifier where@@ -117,40 +103,12 @@ parseGlobalOptions :: Parser GlobalOptions parseGlobalOptions = GlobalOptions- <$> flag True False -- Backwards- ( long "no-line-up"- <> short 'L'- <> help "Don't line up arrows" )- <*> option auto- ( long "indent"- <> short 'i'- <> value 4- <> metavar "NUM"- <> help "How many spaces to use for indentation when formatting" )- <*> flag True False -- Backwards- ( long "no-trailing-newline"- <> short 'N'- <> help "Don't add a trailing newline to a formatted file" )- <*> switch- ( long "always-quote"- <> short 'Q'- <> help "Always quote file names" )- <*> switch- ( long "compress"- <> short 'c'- <> help "Compress the card as much as possible." )- <*> option (Just <$> str)+ <$> option (Just <$> str) ( long "output" <> short 'o' <> value Nothing <> metavar "FILE" <> help "The output file for compilation" )- <*> option auto- ( long "format"- <> short 'f'- <> value FormatJson- <> metavar "FORMAT"- <> help "Compilation format default: json" ) <*> option (Just <$> auto) ( long "kind" <> short 'k'@@ -165,22 +123,17 @@ <> help "Override every deployment to be of the given kind" ) <*> switch ( long "replace-links"- <> help "Replace links at deploy destinations."- )+ <> help "Replace links at deploy destinations." ) <*> switch ( long "replace-files"- <> help "Replace existing files at deploy destinations."- )+ <> help "Replace existing files at deploy destinations." ) <*> switch ( long "replace-Directories"- <> help "Replace existing directories at deploy destinations."- )+ <> help "Replace existing directories at deploy destinations." ) <*> switch ( long "replace-all" <> short 'r'- <> help "Equivalent to --replace-files --replace-directories --replace-links"- )+ <> help "Equivalent to --replace-files --replace-directories --replace-links" ) <*> switch ( long "debug"- <> help "Show al debug information."- )+ <> help "Show al debug information." )
src/Check/Internal.hs view
@@ -31,10 +31,10 @@ | otherwise -- Will not be empty as per line above = case head $ dropWhile impossible cs of- AlreadyDone -> DeploymentDone- Ready i -> ReadyToDeploy i- Dirty s i c -> DirtySituation s i c- Impossible _ -> error "Cannot be the case"+ AlreadyDone -> DeploymentDone+ Ready i -> ReadyToDeploy i+ Dirty s i c -> DirtySituation s i c+ Impossible _ -> error "Cannot be the case" impossible :: CheckResult -> Bool impossible (Impossible _) = True
src/Compiler.hs view
@@ -78,25 +78,18 @@ outputCompiled :: [Deployment] -> Sparker () outputCompiled deps = do- form <- asks conf_compile_format out <- asks conf_compile_output- liftIO $ case form of- FormatJson -> do- let bs = encodePretty deps- case out of- Nothing -> BS.putStrLn bs- Just fp -> BS.writeFile fp bs- _ -> error $ "unrecognized format"+ liftIO $ do+ let bs = encodePretty deps+ case out of+ Nothing -> BS.putStrLn bs+ Just fp -> BS.writeFile fp bs inputCompiled :: FilePath -> Sparker [Deployment] inputCompiled fp = do- form <- asks conf_compile_format- case form of- FormatJson -> do- bs <- liftIO $ BS.readFile fp- case eitherDecode bs of- Left err -> throwError $ CompileError $ "Something went wrong while deserialising json data: " ++ err- Right ds -> return ds- _ -> error $ "unrecognized format"+ bs <- liftIO $ BS.readFile fp+ case eitherDecode bs of+ Left err -> throwError $ CompileError $ "Something went wrong while deserialising json data: " ++ err+ Right ds -> return ds
src/Compiler/Internal.hs view
@@ -14,16 +14,16 @@ compileDecs :: [Declaration] -> InternalCompiler () compileDecs = mapM_ compileDec - compileDec :: Declaration -> InternalCompiler () compileDec (Deploy src dst kind) = do override <- gets state_deployment_kind_override superOverride <- asks conf_compile_override- let resultKind = case (superOverride, override, kind) of- (Nothing, Nothing, Nothing) -> LinkDeployment- (Nothing, Nothing, Just k ) -> k- (Nothing, Just o , _ ) -> o- (Just o , _ , _ ) -> o+ let resultKind+ = case (superOverride, override, kind) of+ (Nothing, Nothing, Nothing) -> LinkDeployment+ (Nothing, Nothing, Just k ) -> k+ (Nothing, Just o , _ ) -> o+ (Just o , _ , _ ) -> o outof <- gets state_outof_prefix into <- gets state_into
src/Compiler/Types.hs view
@@ -11,9 +11,9 @@ import Types data Deployment = Put- { deployment_srcs :: [FilePath]- , deployment_dst :: FilePath- , deployment_kind :: DeploymentKind+ { deployment_srcs :: [FilePath]+ , deployment_dst :: FilePath+ , deployment_kind :: DeploymentKind } deriving Eq instance Show Deployment where@@ -27,22 +27,25 @@ quote = (\s -> "\"" ++ s ++ "\"") instance FromJSON Deployment where- parseJSON (Object o) = Put <$> o .: "sources"- <*> o .: "destination"- <*> o .: "deployment kind"+ parseJSON (Object o)+ = Put <$> o .: "sources"+ <*> o .: "destination"+ <*> o .: "deployment kind" parseJSON _ = mzero instance ToJSON Deployment where- toJSON depl = object [- "sources" .= deployment_srcs depl- , "destination" .= deployment_dst depl- , "deployment kind" .= deployment_kind depl- ]+ toJSON depl+ = object+ [ "sources" .= deployment_srcs depl+ , "destination" .= deployment_dst depl+ , "deployment kind" .= deployment_kind depl+ ] type CompilerPrefix = [PrefixPart] -data PrefixPart = Literal String- | Alts [String]+data PrefixPart+ = Literal String+ | Alts [String] deriving (Show, Eq) data CompilerState = CompilerState
src/Compiler/Utils.hs view
@@ -9,11 +9,11 @@ initialState :: PureCompiler CompilerState initialState = do override <- asks conf_compile_kind- return $ CompilerState {- state_deployment_kind_override = override- , state_into = ""- , state_outof_prefix = []- }+ return $ CompilerState+ { state_deployment_kind_override = override+ , state_into = ""+ , state_outof_prefix = []+ } addDeployment :: Deployment -> InternalCompiler () addDeployment d = tell ([d], [])
src/Config.hs view
@@ -3,14 +3,8 @@ import Config.Types defaultConfig :: SparkConfig-defaultConfig = Config {- conf_format_lineUp = False- , conf_format_indent = 2- , conf_format_trailingNewline = True- , conf_format_alwaysQuote = False- , conf_format_oneLine = False- , conf_compile_output = Nothing- , conf_compile_format = FormatJson+defaultConfig = Config+ { conf_compile_output = Nothing , conf_compile_kind = Nothing , conf_compile_override = Nothing , conf_deploy_replace_links = False
src/Config/Types.hs view
@@ -2,38 +2,12 @@ import CoreTypes -data SparkConfig = Config {- conf_format_lineUp :: Bool- , conf_format_indent :: Int- , conf_format_trailingNewline :: Bool- , conf_format_alwaysQuote :: Bool- , conf_format_oneLine :: Bool- , conf_compile_output :: Maybe FilePath- , conf_compile_format :: CompileFormat- , conf_compile_kind :: Maybe DeploymentKind- , conf_compile_override :: Maybe DeploymentKind- , conf_deploy_replace_links :: Bool- , conf_deploy_replace_files :: Bool- , conf_deploy_replace_directories :: Bool- , conf_debug :: Bool+data SparkConfig = Config+ { conf_compile_output :: Maybe FilePath+ , conf_compile_kind :: Maybe DeploymentKind+ , conf_compile_override :: Maybe DeploymentKind+ , conf_deploy_replace_links :: Bool+ , conf_deploy_replace_files :: Bool+ , conf_deploy_replace_directories :: Bool+ , conf_debug :: Bool } deriving (Show, Eq)---data CompileFormat = FormatJson- deriving (Show, Eq)--instance Read CompileFormat where- readsPrec _ "json" = [(FormatJson,"")]- readsPrec _ _ = []--data CheckThoroughness = ThoroughnessName- | ThoroughnessChecksum- | ThoroughnessContent- deriving (Show, Eq)--instance Read CheckThoroughness where- readsPrec _ "name" = [(ThoroughnessName,"")]- readsPrec _ "checksum" = [(ThoroughnessChecksum,"")]- readsPrec _ "content" = [(ThoroughnessContent,"")]- readsPrec _ _ = []-
src/Deployer/Internal.hs view
@@ -43,9 +43,10 @@ parseId [] = [] parseId ('$':'(':rest) = (Var id):(parseId next) where (id, (')':next)) = break (\c -> c == ')') rest-parseId (s:ss) = case parseId ss of- (Plain str):r -> (Plain (s:str)):r- r -> (Plain [s]):r+parseId (s:ss)+ = case parseId ss of+ (Plain str):r -> (Plain (s:str)):r+ r -> (Plain [s]):r replaceId :: Environment -> ID -> Either String FilePath replaceId _ (Plain str) = return str
src/Deployer/Types.hs view
@@ -11,25 +11,28 @@ deriving (Show, Eq) instance Read DeployerCardReference where- readsPrec _ fp = case length (words fp) of- 0 -> []- 1 -> if takeExtension fp == ".sus"- then [(DeployerCardUncompiled (CardFileReference fp Nothing) ,"")]- else [(DeployerCardCompiled fp, "")]- 2 -> let [f, c] = words fp- in [(DeployerCardUncompiled (CardFileReference f (Just $ CardNameReference c)), "")]- _ -> []+ readsPrec _ fp+ = case length (words fp) of+ 0 -> []+ 1 -> if takeExtension fp == ".sus"+ then [(DeployerCardUncompiled (CardFileReference fp Nothing) ,"")]+ else [(DeployerCardCompiled fp, "")]+ 2 -> let [f, c] = words fp+ in [(DeployerCardUncompiled (CardFileReference f (Just $ CardNameReference c)), "")]+ _ -> [] type SparkDeployer = StateT DeployerState Sparker data DeployerState = DeployerState -data PreDeployment = Ready FilePath FilePath DeploymentKind- | AlreadyDone- | Error String+data PreDeployment+ = Ready FilePath FilePath DeploymentKind+ | AlreadyDone+ | Error String deriving (Show, Eq) -data ID = Plain String- | Var String+data ID+ = Plain String+ | Var String deriving (Show, Eq)
src/Dispatch.hs view
@@ -7,7 +7,6 @@ import Deployer import Deployer.Types import Dispatch.Types-import Formatter import Parser import Seed import Types@@ -15,11 +14,6 @@ dispatch :: Dispatch -> Sparker () dispatch (DispatchParse fp) = do void $ parseFile fp -- Just parse, throw away the results.--dispatch (DispatchFormat fp) = do- sf <- parseFile fp- str <- formatSparkFile sf- liftIO $ putStrLn str dispatch (DispatchCompile cfr) = do deployments <- compileJob cfr
src/Dispatch/Types.hs view
@@ -8,11 +8,11 @@ type Instructions = (Dispatch, SparkConfig) -data Dispatch = DispatchParse FilePath- | DispatchFormat FilePath- | DispatchCompile CardFileReference- | DispatchCheck DeployerCardReference- | DispatchDeploy DeployerCardReference+data Dispatch+ = DispatchParse FilePath+ | DispatchCompile CardFileReference+ | DispatchCheck DeployerCardReference+ | DispatchDeploy DeployerCardReference deriving (Show, Eq) type Options = (Dispatch, GlobalOptions)
− src/Formatter.hs
@@ -1,276 +0,0 @@-module Formatter where--import Data.List (intersperse)-import Data.Maybe (catMaybes)--import Compiler.Types-import Constants-import Deployer.Types-import Language.Types-import Types--formatSparkFile :: SparkFile -> Sparker String-formatSparkFile (SparkFile _ cs) = do- initial <- initialState- (_, res) <- runSparkFormatter initial (cards cs)- return res--initialState :: Sparker FormatterState-initialState = return $ FormatterState {- state_current_indent = 0- , state_longest_src = 0- , state_newline_before_deploy = True- }---cards :: [Card] -> SparkFormatter ()-cards cs = onLines card cs--delimited :: (a -> SparkFormatter ()) -> [a] -> SparkFormatter ()-delimited thingFormatter things = do- let allThings = map thingFormatter things- sequence_ $ intersperse delimiter allThings--onLines :: (a -> SparkFormatter ()) -> [a] -> SparkFormatter ()-onLines thingFormatter things = do- let allThings = map thingFormatter things- sequence_ $ intersperse newline allThings---card :: Card -> SparkFormatter ()-card (Card name d) = do- string keywordCard- space- string name- space- declaration d--braces :: SparkFormatter () -> SparkFormatter ()-braces f = do- modify (\s -> s {state_newline_before_deploy = True})-- string "{"- newline- indented $ do- newline- f- newline- newline- string "}"--string :: String -> SparkFormatter ()-string s = tell s--interspersed :: [String] -> String -> SparkFormatter ()-interspersed [] _ = return ()-interspersed [s] _ = string s-interspersed (s:ss) i = do- string s- string i- spaced ss---spaced :: [String] -> SparkFormatter ()-spaced strs = interspersed strs " "--space :: SparkFormatter ()-space = onlyIf (not . conf_format_oneLine) $ string " "---newline :: SparkFormatter ()-newline = do- onlyIf (not . conf_format_oneLine) $ string "\n"- ci <- gets state_current_indent- string $ replicate ci ' '--delimiter :: SparkFormatter ()-delimiter = do- oneLine <- asks conf_format_oneLine- if oneLine- then string ";"- else newline--indented :: SparkFormatter () -> SparkFormatter ()-indented func = do- ind <- asks conf_format_indent- indent ind- func- indent (-ind)--indent :: Int -> SparkFormatter ()-indent c = do- ci <- gets state_current_indent- modify (\s -> s {state_current_indent = ci + c})--declarations :: [Declaration] -> SparkFormatter ()-declarations = delimited declaration--declaration :: Declaration -> SparkFormatter ()-declaration (SparkOff cr) = do- string keywordSpark- space- cardReference cr-declaration (Deploy src dst k) = do- nbf <- gets state_newline_before_deploy- if nbf- then newline- else return ()- quoted src- ls <- gets state_longest_src- onlyIf conf_format_lineUp $ string $ replicate (ls - length src) ' '- string " "- mkind k- string " "- quoted dst- modify (\s -> s {state_newline_before_deploy = False})-declaration (IntoDir dir) = do- string keywordInto- space- string dir-declaration (OutofDir dir) = do- string keywordOutof- space- string dir-declaration (DeployKindOverride k) = do- string keywordKindOverride- space- case k of- CopyDeployment -> string keywordCopy- LinkDeployment -> string keywordLink-declaration (Block ds) = do- ls <- gets state_longest_src- let m = maximum $ map srcLen ds- modify (\s -> s {state_longest_src = m} )- braces $ declarations ds- modify (\s -> s {state_longest_src = ls} )- onlyIf conf_format_trailingNewline newline- where- srcLen (Deploy src _ _) = length src- srcLen _ = 0-declaration (Alternatives ds) = do- string keywordAlternatives- space- spaced ds--quoted :: String -> SparkFormatter ()-quoted str = do- alwaysQuote <- asks conf_format_alwaysQuote- if needsQuoting str || alwaysQuote- then do- string "\""- string str- string "\""- else do- string str--needsQuoting :: String -> Bool-needsQuoting str = any (`elem` lineDelimiter ++ whitespaceChars ++ bracesChars) str--onlyIf :: (SparkConfig -> Bool) -> SparkFormatter () -> SparkFormatter ()-onlyIf conf func = do- b <- asks conf- if b- then func- else return ()--kind :: DeploymentKind -> SparkFormatter ()-kind LinkDeployment = string linkKindSymbol-kind CopyDeployment = string copyKindSymbol--mkind :: Maybe DeploymentKind -> SparkFormatter ()-mkind (Just k) = kind k-mkind Nothing = do- onlyIf conf_format_lineUp space- string unspecifiedKindSymbol--cardReference :: CardReference -> SparkFormatter ()-cardReference (CardFile cfr) = cardFileReference cfr-cardReference (CardName cnr) = cardNameReference cnr--cardFileReference :: CardFileReference -> SparkFormatter ()-cardFileReference (CardFileReference fp mnr) = do- string keywordFile- string " "- string fp- case mnr of- Nothing -> return ()- Just (CardNameReference cn) -> do- string " "- string cn--cardNameReference :: CardNameReference -> SparkFormatter ()-cardNameReference (CardNameReference name) = do- string keywordCard- string " "- string name---srcLen :: Deployment -> [Int]-srcLen (Put srcs _ _) = map length srcs--maximums :: [[Int]] -> [Int]-maximums [[]] = []-maximums lss = if all null lss- then []- else (maximum $ map ahead lss):(maximums $ map atail lss)- where- ahead [] = 0- ahead (l:_) = l-- atail [] = []- atail (_:ls) = ls--formatDeployments :: [Deployment] -> String-formatDeployments ds = unlines $ map (formatDeployment lens) ds- where lens = maximums $ map srcLen ds--formatDeployment :: [Int] -> Deployment -> String-formatDeployment ms (Put srcs dst k) = unwords $- [- padded ms srcs- , kindSymbol k- , dst- ]- where- kindSymbol LinkDeployment = linkKindSymbol- kindSymbol CopyDeployment = copyKindSymbol-- padded :: [Int] -> [FilePath] -> String- padded [] [] = []- padded (m:r) [] = replicate m ' ' ++ padded r []- padded [] _ = []- padded (m:r) (s:ss) = s ++ replicate (m - length s) ' ' ++ " " ++ padded r ss--formatPreDeployments :: [(Deployment, PreDeployment)] -> String-formatPreDeployments pdps- = if null output then "Deployment is done already\n" else unlines output- where output = catMaybes $ map formatPreDeployment pdps--formatPostDeployments :: [(Deployment, Maybe String)] -> String-formatPostDeployments ds = unlines $ zipStrs dests $ map (": " ++) ms- where- ms = map mstr predeps-- mstr Nothing = "done"- mstr (Just err) = err-- dests = map (deployment_dst . fst) ds- predeps = map snd ds--formatPreDeployment :: (Deployment, PreDeployment) -> Maybe String-formatPreDeployment (d, (Ready _ _ _)) = Just $ deployment_dst d ++ ": " ++ "ready to deploy"-formatPreDeployment (_, AlreadyDone) = Nothing-formatPreDeployment (d, (Error str)) = Just $ deployment_dst d ++ ": " ++ unwords ["Error:", str]----zipStrs :: [String] -> [String] -> [String]-zipStrs [] [] = []-zipStrs [] ss = ss-zipStrs ss [] = ss-zipStrs (s:ss) (t:ts) = (s++t):(zipStrs ss ts)-----
src/Language/Types.hs view
@@ -38,16 +38,18 @@ instance Read CardFileReference where- readsPrec _ fp = case length (words fp) of- 1 -> [(CardFileReference fp Nothing ,"")]- 2 -> let [f, c] = words fp- in [(CardFileReference f (Just $ CardNameReference c), "")]- _ -> []+ readsPrec _ fp+ = case length (words fp) of+ 1 -> [(CardFileReference fp Nothing ,"")]+ 2 -> let [f, c] = words fp+ in [(CardFileReference f (Just $ CardNameReference c), "")]+ _ -> [] -- | Union card reference-data CardReference = CardFile CardFileReference- | CardName CardNameReference+data CardReference+ = CardFile CardFileReference+ | CardName CardNameReference deriving (Show, Eq)
src/Monad.hs view
@@ -12,8 +12,6 @@ runSparker :: SparkConfig -> Sparker a -> IO (Either SparkError a) runSparker conf func = runReaderT (runExceptT func) conf -- data SparkError = ParseError ParseError | PreCompileError [PreCompileError] | CompileError CompileError
src/Parser/Internal.hs view
@@ -51,8 +51,7 @@ declaration :: Parser Declaration declaration = choice $ map try- [- block+ [ block , alternatives , sparkOff , intoDir@@ -270,8 +269,8 @@ eol :: Parser () eol = skip newline where- newline =- try (string "\r\n")+ newline+ = try (string "\r\n") <|> try (string "\n") <|> string "\r" <?> "end of line"
src/Types.hs view
@@ -1,6 +1,5 @@ module Types- (- module Types+ ( module Types , module CoreTypes , module Monad , module Config.Types@@ -39,13 +38,7 @@ ---[ Options ]--- data GlobalOptions = GlobalOptions- { opt_lineUp :: Bool- , opt_indent :: Int- , opt_trailingNewline :: Bool- , opt_alwaysQuote :: Bool- , opt_compress :: Bool- , opt_output :: Maybe FilePath- , opt_format :: CompileFormat+ { opt_output :: Maybe FilePath , opt_kind :: Maybe DeploymentKind , opt_overrride :: Maybe DeploymentKind , opt_replace_links :: Bool@@ -54,16 +47,3 @@ , opt_replace :: Bool , opt_debug :: Bool } deriving (Show, Eq)-----[ Pretty Types ]-----type SparkFormatter = StateT FormatterState (WriterT String Sparker)-data FormatterState = FormatterState- { state_current_indent :: Int- , state_longest_src :: Int- , state_newline_before_deploy :: Bool- } deriving (Show, Eq)--runSparkFormatter :: FormatterState -> SparkFormatter a -> Sparker ((a, FormatterState), String)-runSparkFormatter state func = runWriterT (runStateT func state)-
super-user-spark.cabal view
@@ -1,5 +1,5 @@ name: super-user-spark-version: 0.3.0.0+version: 0.3.1.0 license: MIT license-file: LICENSE description: Configure your dotfile deployment with a DSL.@@ -13,55 +13,57 @@ library hs-source-dirs: src- exposed-modules: Arguments- , Check- , Check.Internal- , Check.Types- , Compiler- , Compiler.Internal- , Compiler.Types- , Compiler.Utils- , Config.Types- , Config- , Constants- , CoreTypes- , Deployer- , Deployer.Types- , Deployer.Internal- , Dispatch- , Dispatch.Types- , Formatter- , Language.Types- , Monad- , Parser- , Parser.Internal- , PreCompiler- , Seed- , Spark- , Types- , Utils+ exposed-modules: + Arguments+ , Check+ , Check.Internal+ , Check.Types+ , Compiler+ , Compiler.Internal+ , Compiler.Types+ , Compiler.Utils+ , Config.Types+ , Config+ , Constants+ , CoreTypes+ , Deployer+ , Deployer.Types+ , Deployer.Internal+ , Dispatch+ , Dispatch.Types+ , Language.Types+ , Monad+ , Parser+ , Parser.Internal+ , PreCompiler+ , Seed+ , Spark+ , Types+ , Utils - ghc-options: -Wall- -fwarn-unused-imports- -fwarn-incomplete-patterns- -fno-warn-unused-do-bind- -fno-warn-name-shadowing+ ghc-options: + -Wall+ -fwarn-unused-imports+ -fwarn-incomplete-patterns+ -fno-warn-unused-do-bind+ -fno-warn-name-shadowing - build-depends: base >= 4.6 && < 4.9- , aeson >= 0.8 && < 0.11- , aeson-pretty >= 0.7 && < 0.8- , bytestring >= 0.10 && < 0.11- , directory >= 1.2.5 && < 1.3- , filepath >= 1.4 && < 1.5- , mtl >= 2.2 && < 2.3- , optparse-applicative >= 0.11 && < 0.12- , parsec >= 3.1.9 && < 3.2- , process >= 1.2 && < 1.3- , pureMD5 >= 2.1 && < 2.2- , shelly >= 1.6 && < 1.7- , text >= 1.2 && < 1.3- , transformers >= 0.4 && < 0.5- , unix >= 2.7 && < 2.8+ build-depends: + base >= 4.6 && < 5+ , aeson >= 0.8 && < 1.1+ , aeson-pretty >= 0.7 && < 0.9+ , bytestring >= 0.10 && < 0.11+ , directory >= 1.2.5 && < 1.3+ , filepath >= 1.4 && < 1.5+ , mtl >= 2.2 && < 2.3+ , optparse-applicative >= 0.11 && < 0.14+ , parsec >= 3.1.9 && < 3.2+ , process >= 1.2 && < 1.5+ , pureMD5 >= 2.1 && < 2.2+ , shelly >= 1.6 && < 1.7+ , text >= 1.2 && < 1.3+ , transformers >= 0.4 && < 0.6+ , unix >= 2.7 && < 2.8 default-language: Haskell2010 executable spark@@ -73,40 +75,43 @@ -fno-warn-unused-do-bind -fno-warn-name-shadowing -threaded -rtsopts -with-rtsopts=-N- build-depends: base >= 4.6 && < 4.9- , super-user-spark+ build-depends: + base >= 4.6 && < 5+ , super-user-spark default-language: Haskell2010 test-suite spark-tests type: exitcode-stdio-1.0 main-is: MainTest.hs- hs-source-dirs: src, test- other-modules: CheckSpec- , ParserSpec- , CompilerSpec- , DeployerSpec- , SeedSpec- , EndToEndSpec- build-depends: base >= 4.6 && < 4.9- , super-user-spark- , hspec >= 2.2 && < 2.3- , hspec-core >= 2.2 && < 2.3- , HUnit >= 1.2 && < 1.3- , QuickCheck >= 2.8 && < 2.9- , aeson >= 0.8 && < 0.11- , aeson-pretty >= 0.7 && < 0.8- , bytestring >= 0.10 && < 0.11- , directory >= 1.2 && < 1.3- , filepath >= 1.4 && < 1.5- , mtl >= 2.2 && < 2.3- , optparse-applicative >= 0.11 && < 0.12- , parsec >= 3.1 && < 3.2- , process >= 1.2 && < 1.3- , pureMD5 >= 2.1 && < 2.2- , shelly >= 1.6 && < 1.7- , text >= 1.2 && < 1.3- , transformers >= 0.4 && < 0.5- , unix >= 2.7 && < 2.8+ hs-source-dirs: test+ other-modules: + CheckSpec+ , ParserSpec+ , CompilerSpec+ , DeployerSpec+ , SeedSpec+ , EndToEndSpec+ build-depends: + base >= 4.6 && < 5+ , super-user-spark+ , hspec >= 2.2 && < 2.4+ , hspec-core >= 2.2 && < 2.4+ , HUnit >= 1.2 && < 1.6+ , QuickCheck >= 2.8 && < 2.10+ , aeson + , aeson-pretty + , bytestring + , directory + , filepath + , mtl + , optparse-applicative + , parsec + , process + , pureMD5 + , shelly + , text + , transformers + , unix default-language: Haskell2010
test/CompilerSpec.hs view
@@ -330,9 +330,6 @@ exactTests :: Spec exactTests = do- let runJsonSparker :: Sparker a -> IO (Either SparkError a)- runJsonSparker func = flip runReaderT (defaultConfig {conf_compile_format = FormatJson}) $ runExceptT func- describe "exact tests" $ do let dir = "test_resources/exact_compile_test_src" forFileInDirss [dir] $ \fp ->@@ -343,7 +340,7 @@ let orig = fp let result = fp <.> "res" ads <- runDefaultSparker $ compileJob $ CardFileReference orig Nothing- eds <- runJsonSparker $ inputCompiled result+ eds <- runDefaultSparker $ inputCompiled result ads `shouldBe` eds
test/EndToEndSpec.hs view
@@ -3,6 +3,7 @@ import Spark import System.Directory hiding (createDirectoryIfMissing) import System.Environment (withArgs)+import System.Exit (ExitCode (ExitSuccess)) import System.FilePath.Posix ((</>)) import System.Posix.Files import Test.Hspec@@ -10,6 +11,16 @@ spec :: Spec spec = do+ helpTextSpec+ regularWorkflowSpec++helpTextSpec :: Spec+helpTextSpec = describe "help text test" $ do+ it "shows the help text without crashing" $ do+ withArgs ["--help"] spark `shouldThrow` (== ExitSuccess)++regularWorkflowSpec :: Spec+regularWorkflowSpec = do let sandbox = "test_sandbox" let setup = createDirectoryIfMissing sandbox let teardown = removeDirectoryRecursive sandbox