effable 0.3.1.0 → 0.3.1.1
raw patch · 3 files changed
+182/−93 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- README.md +1/−1
- effable.cabal +1/−1
- src/Data/Effable.hs +180/−91
README.md view
@@ -3,7 +3,7 @@ _A data structure for emission plans_ [](./LICENSE)-+[](https://hackage.haskell.org/package/effable)  <br>
effable.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: effable-version: 0.3.1.0+version: 0.3.1.1 stability: experimental category: Data synopsis: A data structure for emission plans
src/Data/Effable.hs view
@@ -108,8 +108,8 @@ import Data.Word (Word8) import Data.Foldable import Data.Maybe qualified as Maybe-import Data.List qualified as L import System.Environment qualified as Env+import Control.Exception qualified as E {- implementation notes:@@ -122,6 +122,8 @@ - instances of "\ \" etc. in docstrings are used to sync vertical alignment/whitespace padding between code and the generated haddock +- "> >>> ..." in docstrings can be used to inhibit doctest execution of the line yet have haddock render it as ">>> ..."+ - haddock table bug: won't render if following immediately after heading - workaround: put a ` ` (= SGML whitespace) between @@ -130,7 +132,12 @@ {- $setup >>> import Data.Word (Word8) >>> import Control.Monad+>>> import Data.Foldable >>> :set -XOverloadedStrings++Overrides for env_example:+>>> isShellM = pure True :: IO Bool+>>> isVerboseM = pure False :: IO Bool -} @@ -766,135 +773,217 @@ --- example --- ------- +-- note: for reasons of making tests deterministic, for some bindings, doctests will use hard-coded values from the $setup block+ {- $env_example ->>> import qualified System.Environment as Env->>> import qualified Data.List as L->>> import qualified Data.Maybe as Maybe+The following creates an t'Effable' that -Preparation - create some helper functions:+- represents a sequence of 'String's, and+- conditionally includes each 'String' based on an 'IO' action evaluated at emission time. ->>> haveVar name = Maybe.isJust <$> Env.lookupEnv name->>> envVarsM = L.genericLength <$> Env.getEnvironment :: IO Word8->>> envVars = embedAction envVarsM :: Effable IO Word8+>>> import qualified System.Environment as Env+>>> import qualified Data.Maybe as Maybe -Create an 'Effable', using @OverloadedStrings@ to promote 'String' literals like @"shell-invoked"@ to an 'Effable':+> >>> isShellM = Maybe.isJust <$> Env.lookupEnv "SHELL" :: IO Bool+> >>> isVerboseM = Maybe.isJust <$> Env.lookupEnv "EFF_VERBOSE" :: IO Bool >>> :set -XOverloadedStrings >>> :{-eff =- (show <$> envVars) `onlyIf` haveVar "DBG"- <> "shell-invoked" `onlyIf` haveVar "SHELL"- <> "DONE."+linesEff :: Effable IO String+linesEff =+ "shell-invoked" `onlyIf` isShellM+ <> "verbose-info" `onlyIf` isVerboseM+ <> "DONE." :} -Depending on the environment variables present, running the 'Effable' with 'putStrLn' would return an @'IO' ()@ that prints something matching this:+To emit the value, we use 'run' with 'putStrLn' as the emission function. The results shown below assume @SHELL@ is a set environment variable but+ @EFF_VERBOSE@ is not. ->>> run putStrLn eff-...+>>> :{+printEff :: Effable IO String -> IO ()+printEff = run putStrLn+:}++>>> printEff linesEff+shell-invoked DONE. -E.g. if 92 environment variables are set, two of which are @DBG@ and @SHELL@, the following would be printed:+The embedded 'String's can be 'fmap'-ed, e.g.: -> >>> run putStrLn eff-> 92-> shell-invoked-> DONE.+>>> :{+leftline :: String -> String+leftline = ("| " <>)+:} -__It is crucial that the code was written so that the IO action yielded a 'Word8'.__ It has 256 inhabitants, which is manageable.+>>> printEff (leftline <$> linesEff)+| shell-invoked+| DONE. -== Comparison: IO-monadic code+It should be noted that the functionality we implemented above could just as well have been expressed without t'Effable': a value of type @'IO' ['String']@ can be equally capable. Its lines could be 'fmap'-ed with @leftline@, and including each list element (= line) could be conditioned on an @'IO' 'Bool'@. -This version, written directly in the IO monad, is equivalent in what it prints: +=== Adding a wrapper++Let's say we have this function:++>>> import qualified Control.Exception as E+>>> >>> :{-monadicIO = do- isDbg <- haveVar "DBG"- isShell <- haveVar "SHELL"- --- n <- envVarsM- let nStr = show n- --- when isDbg $ putStrLn nStr- when isShell $ putStrLn "shell-invoked"- putStrLn "DONE."+-- | Run an IO action and then print a line indicating+-- whether it threw an exception or not.+withReporting :: IO () -> IO ()+withReporting x = do+ r <- E.try x+ case (r :: Either E.SomeException ()) of+ Left _ -> putStrLn "(FAIL)"+ Right _ -> putStrLn "(OK)" :} ->>> monadicIO-...+The following t'Effable' will apply @withReporting@ to any emission of the first 'String':++>>> :{+linesEff_reporting :: Effable IO String+linesEff_reporting =+ wrap withReporting ("shell-invoked" `onlyIf` isShellM )+ <> ("verbose-info" `onlyIf` isVerboseM)+ <> "DONE."+:}++E.g.:++>>> printEff linesEff_reporting+shell-invoked+(OK) DONE. -== @eff@ vs. @monadicIO@+>>> printEff (leftline <$> linesEff_reporting)+| shell-invoked+(OK)+| DONE. -- (-) blows-up unless @envVarsM@ is carefully implemented to limit the domain of what the action returns+The second output includes the line -- (-) is slower, and more expensive in allocations+> (OK) -- (+) is pure, and has a type that allows further transformations:+rather than - > --- GHCi session ---- >- > λ> :t eff- > eff :: Effable IO String- >- > λ> :t monadicIO- > monadicIO :: IO ()+> | (OK) - ...e.g.:+which is the intended behaviour: - > >>> leftline = ("| "<>)- > >>> run putStrLn (leftline <$> eff)- > | 92- > | shell-invoked- > | DONE.+- @leftline '<$>' ..@ modifies each embedded 'String' (= line), while+- @'wrap' withReporting@ modifies how each line is emitted. +The above example illustrates that an t'Effable' with an emission wrapper still retains transformability, e.g. with 'fmap'. If we would not use an t'Effable' but instead create an @'IO' _@ that includes the wrapper, it would have to be an @'IO' ()@ - which is opaque and no longer transformable.+ -} -_env_example_docstring :: IO ()-_env_example_docstring = main_env_example- where+{- | Code used in the example. (internal/for maintenance + typechecking) - haveVar :: String -> IO Bool- haveVar name = Maybe.isJust <$> Env.lookupEnv name- envVarsM = L.genericLength <$> Env.getEnvironment :: IO Word8- envVars = embedAction envVarsM :: Effable IO Word8+Useful terminal command:+```sh+(unset EFF_VERBOSE; SHELL=true cabal repl --repl-options="-e _env_example_code")+```+-}+_env_example_code :: IO ()+_env_example_code = printExpressions where - eff =- (show <$> envVars) `onlyIf` haveVar "DBG"- <> "shell-invoked" `onlyIf` haveVar "SHELL"- <> "DONE."+ -- Effable without wrapper+ -- ----------------------- - _res0 = run putStrLn eff+ isShellM = Maybe.isJust <$> Env.lookupEnv "SHELL" :: IO Bool+ isVerboseM = Maybe.isJust <$> Env.lookupEnv "EFF_VERBOSE" :: IO Bool - monadicIO :: IO ()- monadicIO = do- isDbg <- haveVar "DBG"- isShell <- haveVar "SHELL"+ linesEff :: Effable IO String+ linesEff =+ "shell-invoked" `onlyIf` isShellM+ <> "verbose-info" `onlyIf` isVerboseM+ <> "DONE." - n <- envVarsM- let nStr = show n+ printEff :: Effable IO String -> IO ()+ printEff = run putStrLn - when isDbg $ putStrLn nStr- when isShell $ putStrLn "shell-invoked"- putStrLn "DONE."+ leftline :: String -> String+ leftline = ("| " <>) - leftline = ("| "<>)- _res_leftline = run putStrLn (leftline <$> eff)+ _res_effWithout = printEff linesEff+ _res_effWithout_ll = printEff (leftline <$> linesEff) - main_env_example :: IO ()- main_env_example = do- print . length . inEffable $ eff- print . length . inEffable $ ifThenElse (haveVar "SHELL") eff eff - putStrLn "\n_res0:" ; _res0- putStrLn "\n_res_leftline"; _res_leftline- putStrLn "\nmonadic:" ; monadicIO+ -- Effable WITH wrapper+ -- -------------------- - -- not used: `eff` expressed with a do-block:- _eff_do :: Effable IO String- _eff_do = do- n <- envVars- let nStr = show n- l1 <- when' (haveVar "DBG" ) (string nStr)- l2 <- when' (haveVar "SHELL") "shell-invoked"- pure (l1 <> l2 <> "DONE.")+ withReporting :: IO () -> IO ()+ withReporting x = do+ r <- E.try x+ case (r :: Either E.SomeException ()) of+ Left _ -> putStrLn "(FAIL)"+ Right _ -> putStrLn "(OK)"++ linesEff_reporting :: Effable IO String+ linesEff_reporting =+ wrap withReporting ("shell-invoked" `onlyIf` isShellM )+ <> ("verbose-info" `onlyIf` isVerboseM)+ <> "DONE."++ _res_eff_reporting = printEff linesEff_reporting+ _res_eff_reporting_ll = printEff (leftline <$> linesEff_reporting)+++ -- Implementations in IO (no Effable)+ -- ----------------------------------++ -- (keep this code even if not used in the docstring)++ linesIO :: IO [String]+ linesIO = do+ isShell <- isShellM+ isVerbose <- isVerboseM+ pure $+ (if isShell then ["shell-invoked"] else [])+ ++ (if isVerbose then ["verbose-info" ] else [])+ ++ ["DONE."]++ printIO :: IO [String] -> IO ()+ printIO_ll :: IO [String] -> IO ()+ printIO_ll' :: IO [String] -> IO ()++ printIO x = x >>= traverse_ putStrLn+ printIO_ll x = x >>= traverse_ (putStrLn . leftline) -- "modify emission"+ printIO_ll' x = printIO $ fmap leftline <$> x -- "modify value"++ printIO__linesIO__reporting :: IO ()+ printIO__linesIO__reporting = do+ isShell <- isShellM+ isVerbose <- isVerboseM+ withReporting $ when isShell $ putStrLn "shell-invoked"+ id $ when isVerbose $ putStrLn "verbose-info"+ putStrLn "DONE."+++ -- (For observing what the expressions print)+ -- ------------------------------------------++ printExpressions :: IO ()+ printExpressions = do+ put "\n=== Effable without wrapper ==="+ put "--- plain:" ; printEff linesEff+ put "--- leftlined:" ; printEff (leftline <$> linesEff)++ put "\n=== Effable WITH wrapper ==="+ put "--- plain:" ; printEff linesEff_reporting+ put "--- leftlined:" ; printEff (leftline <$> linesEff_reporting)++ put "\n-----------------------------------"++ put "\n=== IO [String] without wrapper ==="+ put "--- plain:" ; printIO linesIO+ put "--- leftlined em.:" ; printIO_ll linesIO+ put "--- leftlined value:"; printIO_ll' linesIO++ put "\n=== IO [String] WITH wrapper ==="+ put "--- (plain, opaque):"; printIO__linesIO__reporting++ where+ put s = putStrLn ("\n" ++ s)