zifter 0.0.1.6 → 0.0.1.7
raw patch · 8 files changed
+110/−121 lines, 8 filesdep ~ansi-terminaldep ~asyncdep ~directoryPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: ansi-terminal, async, directory, exceptions, filepath, optparse-applicative, path, path-io, process, safe, stm, validity, validity-path
API changes (from Hackage documentation)
- Zifter.Zift.Types: instance Data.Validity.Validity Zifter.Zift.Types.ZiftContext
Files
- src/Zifter.hs +22/−14
- src/Zifter/OptParse.hs +25/−25
- src/Zifter/Recurse.hs +3/−1
- src/Zifter/Setup/Types.hs +9/−8
- src/Zifter/Zift/Types.hs +1/−23
- test/Zifter/ZiftSpec.hs +29/−29
- test/ZifterSpec.hs +6/−6
- zifter.cabal +15/−15
src/Zifter.hs view
@@ -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
src/Zifter/OptParse.hs view
@@ -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 =
src/Zifter/Recurse.hs view
@@ -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
src/Zifter/Setup/Types.hs view
@@ -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+ }
src/Zifter/Zift/Types.hs view
@@ -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)
test/Zifter/ZiftSpec.hs view
@@ -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 ()
test/ZifterSpec.hs view
@@ -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 ()
zifter.cabal view
@@ -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