diff --git a/src/Zifter.hs b/src/Zifter.hs --- a/src/Zifter.hs +++ b/src/Zifter.hs @@ -74,13 +74,21 @@ import Safe import System.Console.ANSI import qualified System.Directory as D - (canonicalizePath, getPermissions, setOwnerExecutable, - setPermissions) + ( canonicalizePath + , getPermissions + , setOwnerExecutable + , setPermissions + ) import System.Environment (getProgName) import System.Exit import qualified System.FilePath as FP (joinPath, splitPath) import System.IO - (BufferMode(NoBuffering), hFlush, hSetBuffering, stderr, stdout) + ( BufferMode(NoBuffering) + , hFlush + , hSetBuffering + , stderr + , stdout + ) import Zifter.OptParse import Zifter.Recurse @@ -140,12 +148,12 @@ pchan <- newTChanIO let ctx = ZiftContext - { rootdir = rd - , tmpdir = td - , settings = sets - , printChan = pchan - , recursionList = [] - } + { rootdir = rd + , tmpdir = td + , settings = sets + , printChan = pchan + , recursionList = [] + } result <- runZift ctx (func ctx) code <- case result of @@ -265,7 +273,7 @@ Right output -> do outputOneToken output printer - in printer + in printer where outputOneToken :: ZiftToken -> IO () outputOneToken (ZiftToken _ Nothing) = pure () @@ -296,7 +304,7 @@ Just (st', buf) -> do outputBuf buf printer st' - in printer LinearUnknown + in printer LinearUnknown where outputBuf :: Buf -> IO () outputBuf BufNotReady = pure () @@ -363,9 +371,9 @@ go (LinearBranch ls rs) = let (ls', lbuf) = go ls (rs', rbuf) = go rs - in case lbuf of - BufNotReady -> (LinearBranch ls' rs, lbuf) - BufReady _ -> (LinearBranch ls' rs', lbuf <> rbuf) + in case lbuf of + BufNotReady -> (LinearBranch ls' rs, lbuf) + BufReady _ -> (LinearBranch ls' rs', lbuf <> rbuf) data Buf = BufNotReady diff --git a/src/Zifter/OptParse.hs b/src/Zifter/OptParse.hs --- a/src/Zifter/OptParse.hs +++ b/src/Zifter/OptParse.hs @@ -26,9 +26,9 @@ where sets = Settings - { setsOutputColor = flagsOutputColor - , setsOutputMode = fromMaybe OutputLinear flagsOutputMode - } + { setsOutputColor = flagsOutputColor + , setsOutputMode = fromMaybe OutputLinear flagsOutputMode + } d = case cmd of CommandRun -> DispatchRun @@ -51,13 +51,13 @@ where pfs = ParserPrefs - { prefMultiSuffix = "" - , prefDisambiguate = True - , prefShowHelpOnError = True - , prefShowHelpOnEmpty = True - , prefBacktrack = True - , prefColumns = 80 - } + { prefMultiSuffix = "" + , prefDisambiguate = True + , prefShowHelpOnError = True + , prefShowHelpOnEmpty = True + , prefBacktrack = True + , prefColumns = 80 + } argParser :: ParserInfo Arguments argParser = info (helper <*> parseArgs) hlp @@ -119,23 +119,23 @@ let enabledValue = True disabledValue = False defaultValue = True - in (last <$> - some - ((flag' - enabledValue - (hidden <> internal <> long name <> help helpText <> mods) <|> + in (last <$> + some + ((flag' + enabledValue + (hidden <> internal <> long name <> help helpText <> mods) <|> + flag' + disabledValue + (hidden <> internal <> long ("no-" ++ name) <> help helpText <> + mods)) <|> flag' disabledValue - (hidden <> internal <> long ("no-" ++ name) <> help helpText <> - mods)) <|> - flag' - disabledValue - (long ("[no-]" ++ name) <> - help - ("Enable/disable " ++ - helpText ++ " (default: " ++ show defaultValue ++ ")") <> - mods))) <|> - pure defaultValue + (long ("[no-]" ++ name) <> + help + ("Enable/disable " ++ + helpText ++ " (default: " ++ show defaultValue ++ ")") <> + mods))) <|> + pure defaultValue outputModeFlag :: Parser (Maybe OutputMode) outputModeFlag = diff --git a/src/Zifter/Recurse.hs b/src/Zifter/Recurse.hs --- a/src/Zifter/Recurse.hs +++ b/src/Zifter/Recurse.hs @@ -77,7 +77,9 @@ let cmd = unwords [toFilePath scriptPath, command] let cp = (shell cmd) - {cwd = Just $ toFilePath $ parent scriptPath, std_out = CreatePipe} + { cwd = Just $ toFilePath $ parent scriptPath + , std_out = CreatePipe + } (_, mouth, merrh, ph) <- liftIO $ createProcess cp ec <- liftIO $ waitForProcess ph case mouth of diff --git a/src/Zifter/Setup/Types.hs b/src/Zifter/Setup/Types.hs --- a/src/Zifter/Setup/Types.hs +++ b/src/Zifter/Setup/Types.hs @@ -15,13 +15,14 @@ instance Monoid ZiftSetup where mempty = ZiftSetup - { ziftPreprocessor = pure () - , ziftPreChecker = pure () - , ziftChecker = pure () - } + { ziftPreprocessor = pure () + , ziftPreChecker = pure () + , ziftChecker = pure () + } mappend z1 z2 = ZiftSetup - { ziftPreprocessor = ziftPreprocessor z1 `mappend` ziftPreprocessor z2 - , ziftPreChecker = ziftPreChecker z1 `mappend` ziftPreChecker z2 - , ziftChecker = ziftChecker z1 `mappend` ziftChecker z2 - } + { ziftPreprocessor = + ziftPreprocessor z1 `mappend` ziftPreprocessor z2 + , ziftPreChecker = ziftPreChecker z1 `mappend` ziftPreChecker z2 + , ziftChecker = ziftChecker z1 `mappend` ziftChecker z2 + } diff --git a/src/Zifter/Zift/Types.hs b/src/Zifter/Zift/Types.hs --- a/src/Zifter/Zift/Types.hs +++ b/src/Zifter/Zift/Types.hs @@ -41,11 +41,6 @@ | R deriving (Show, Eq, Generic) -instance Validity ZiftContext where - isValid = isValid . rootdir -#if MIN_VERSION_validity(0,4,0) - validate zc = rootdir zc "rootdir" -#endif data Zift a where ZiftPure :: a -> Zift a ZiftCtx :: Zift ZiftContext @@ -107,9 +102,7 @@ | ZiftFailed String deriving (Show, Eq, Generic) -instance Validity a => Validity (ZiftResult a) where - isValid (ZiftSuccess a) = isValid a - isValid _ = True +instance Validity a => Validity (ZiftResult a) instance Monoid a => Monoid (ZiftResult a) where mempty = ZiftSuccess mempty @@ -132,18 +125,3 @@ instance MonadFail ZiftResult where fail = ZiftFailed --- -- | Internal: do not use yourself. --- tryFlushZiftBuffer :: ZiftContext -> ZiftState -> IO ZiftState --- tryFlushZiftBuffer ctx st = --- if flushable $ recursionList ctx --- then do --- let zos = reverse $ bufferedOutput st --- st' = st {bufferedOutput = []} --- atomically $ mapM_ (writeTChan $ printChan ctx) zos --- pure st' --- else pure st --- --- -- The buffer is flushable when it's guaranteed to be the first in the in-order --- -- of the evaluation tree. --- flushable :: [LR] -> Bool --- flushable = all (== L) diff --git a/test/Zifter/ZiftSpec.hs b/test/Zifter/ZiftSpec.hs --- a/test/Zifter/ZiftSpec.hs +++ b/test/Zifter/ZiftSpec.hs @@ -34,8 +34,8 @@ let func = do pure () pure () - in func `outputShouldBe` - [ZiftToken [L] Nothing, ZiftToken [R] Nothing] + in func `outputShouldBe` + [ZiftToken [L] Nothing, ZiftToken [R] Nothing] it "printZift outputs one message" $ printZift "hello" `outputShouldBe` [ ZiftToken @@ -46,18 +46,18 @@ let func = do printZift "hello" printZift "world" - in func `outputShouldBe` - [ ZiftToken - [L] - (Just - ZiftOutput - {outputColors = [], outputMessage = "hello"}) - , ZiftToken - [R] - (Just - ZiftOutput - {outputColors = [], outputMessage = "world"}) - ] + in func `outputShouldBe` + [ ZiftToken + [L] + (Just + ZiftOutput + {outputColors = [], outputMessage = "hello"}) + , ZiftToken + [R] + (Just + ZiftOutput + {outputColors = [], outputMessage = "world"}) + ] describe "addState" $ do it "stores the first output on the left for [L]" $ forAllUnchecked $ \mzo -> @@ -75,8 +75,8 @@ ln = l Nothing t bs es eb = let (as, ab) = flushState bs - in do as `shouldBe` es - ab `shouldBe` eb + in do as `shouldBe` es + ab `shouldBe` eb it "flushes a simple branch at the top level" $ forAllUnchecked $ \(hello, world) -> t @@ -91,7 +91,7 @@ "does not flush the right side of a branch if the left side is unknown" $ forAllUnchecked $ \msg -> let s = b u (l (Just msg)) - in t s s BufNotReady + in t s s BufNotReady it "flushes a branch with two leaves" $ forAllUnchecked $ \(hello, world) -> t @@ -139,15 +139,15 @@ it "flushes the entire tree for any done tree" $ forAll doneTree $ \st -> let (s', _) = flushState st - in s' `shouldBe` makeForceFlushed st + in s' `shouldBe` makeForceFlushed st it "flushes the entire left tree for any tree whose left part is done" $ forAllShrink doneTree (map makeForceFlushed . shrinkUnchecked) $ \dt -> forAllUnchecked $ \ut -> let s = b dt ut (rs', b2) = flushState ut - in t s - (b (makeForceFlushed dt) rs') - (flushStateAll dt <> b2) + in t s + (b (makeForceFlushed dt) rs') + (flushStateAll dt <> b2) it "can only grow the depth of the state" $ forAll (genUnchecked `suchThat` @@ -189,14 +189,14 @@ pchan <- newTChanIO let ctx = ZiftContext - { rootdir = rd - , tmpdir = td - , settings = - Settings - {setsOutputColor = False, setsOutputMode = OutputFast} - , printChan = pchan - , recursionList = [] - } + { rootdir = rd + , tmpdir = td + , settings = + Settings + {setsOutputColor = False, setsOutputMode = OutputFast} + , printChan = pchan + , recursionList = [] + } fmvar <- newEmptyTMVarIO ec <- ziftRunner ctx fmvar func ec `shouldBe` ZiftSuccess () diff --git a/test/ZifterSpec.hs b/test/ZifterSpec.hs --- a/test/ZifterSpec.hs +++ b/test/ZifterSpec.hs @@ -23,10 +23,10 @@ td <- resolveDir rd ".zifter" let ctx = ZiftContext - { rootdir = rd - , tmpdir = td - , settings = sets - , printChan = pchan - , recursionList = [] - } + { rootdir = rd + , tmpdir = td + , settings = sets + , printChan = pchan + , recursionList = [] + } runZift ctx (pure ()) `shouldReturn` ZiftSuccess () diff --git a/zifter.cabal b/zifter.cabal --- a/zifter.cabal +++ b/zifter.cabal @@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 312738552ea07cdd468fd82f5fa86345abfa17274a706308c2bd01fb5b06d3fa +-- hash: 79144ce70fe7248e15a06ec509da364a7ea3ee95256e1c8067b449dc3fbad991 name: zifter -version: 0.0.1.6 +version: 0.0.1.7 synopsis: zifter description: zifter category: Zift @@ -23,20 +23,20 @@ src/ ghc-options: -Wall build-depends: - ansi-terminal >=0.6 && <0.8 - , async >=2.1 && <2.2 + ansi-terminal + , async , base >=4.9 && <=5 - , directory >=1.2 && <1.4 - , exceptions >=0.8 && <0.9 - , filepath >=1.4 && <1.5 - , optparse-applicative >=0.13 && <0.15 - , path >=0.6 && <0.7 - , path-io >1.3 && <1.4 - , process >=1.4 && <1.7 - , safe >=0.3 && <0.4 - , stm >=2.4 && <2.5 - , validity >=0.3 && <0.5 - , validity-path >=0.1 && <0.3 + , directory + , exceptions + , filepath + , optparse-applicative + , path + , path-io + , process + , safe + , stm + , validity >=0.3 && <0.6 + , validity-path >=0.1 && <0.4 exposed-modules: Zifter Zifter.OptParse