rio 0.0.2.0 → 0.0.3.0

raw patch · 24 files changed

+1765/−1250 lines, 24 filesdep +process

Dependencies added: process

Files

• README.md +35/−0
• rio.cabal +19/−5
• src/RIO.hs +22/−4
• src/RIO/ByteString.hs +1/−1
• src/RIO/Char.hs +8/−0
• src/RIO/List.hs +32/−0
• src/RIO/Logger.hs +0/−341
• src/RIO/Prelude.hs +0/−583
• src/RIO/Prelude/Display.hs +50/−0
• src/RIO/Prelude/Extra.hs +46/−0
• src/RIO/Prelude/IO.hs +49/−0
• src/RIO/Prelude/Lens.hs +23/−0
• src/RIO/Prelude/Logger.hs +530/−0
• src/RIO/Prelude/RIO.hs +32/−0
• src/RIO/Prelude/Reexports.hs +299/−0
• src/RIO/Prelude/Renames.hs +35/−0
• src/RIO/Prelude/Text.hs +21/−0
• src/RIO/Prelude/URef.hs +57/−0
• src/RIO/Process.hs +452/−295
• src/RIO/Text.hs +19/−0
• test/RIO/ListSpec.hs +15/−0
• test/RIO/LoggerSpec.hs +4/−20
• test/RIO/PreludeSpec.hs +0/−1
• test/RIO/TextSpec.hs +16/−0

@@ -196,6 +196,31 @@ StaticPointers ``` +### GHC Options++We recommend using these GHC complier warning flags on all projects, to catch +problems that might otherwise go overlooked:++* `-Wall`+* `-Wcompat`+* `-Wincomplete-record-updates`+* `-Wincomplete-uni-patterns`+* `-Wredundant-constraints`++You may add them per file, or to your package.yaml, or pass them on the command +line when running ghc. We plan to add these to the package.yaml of our project +template, once its ready.++For code targeting production use, you should also use the flag that turns all +warnings into errors, to force you to resolve the warnings before you ship your +code:++* `-Werror`++Further reading: Alexis King explains why these are a good idea in [her blog +post](https://lexi-lambda.github.io/blog/2018/02/10/an-opinionated-guide-to-haskell-in-2018/) +which was the original inspiration for this section.+ ### Monads  A primary design choice you'll need to make in your code is how to@@ -344,3 +369,13 @@  __TODO__ Point to coding style guidelines, and discuss [hindent](https://github.com/commercialhaskell/hindent).++### Module hierarchy++The `RIO.Prelude.` module hierarchy contains identifiers which are reexported+by the `RIO` module. The reason for this is to make it easier to view the+generated Haddocks. The `RIO` module itself is intended to be imported+unqualified, with `NoImplicitPrelude` enabled. All other modules are _not_+reexported by the `RIO` module,+and will document inside of them whether they should be imported qualified or+unqualified.

@@ -1,11 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.20.0.+-- This file has been generated from package.yaml by hpack version 0.21.2. -- -- see: https://github.com/sol/hpack ----- hash: 613b330708b2a2c48f3062883ce3b2dac673747a9d552e04e84685747f23f911+-- hash: 03ea77dc722a584f48bb591def1080ab6f6e2d687ff376c32027b008640c377e  name:           rio-version:        0.0.2.0+version:        0.0.3.0 synopsis:       A standard library for Haskell description:    Work in progress library, see README at <https://github.com/commercialhaskell/rio#readme> category:       Control@@ -41,6 +41,7 @@     , microlens     , mtl     , primitive+    , process     , text     , time     , typed-process >=0.2.1.0@@ -58,13 +59,23 @@       RIO       RIO.ByteString       RIO.ByteString.Lazy+      RIO.Char       RIO.Directory       RIO.FilePath       RIO.HashMap       RIO.HashSet       RIO.List-      RIO.Logger       RIO.Map+      RIO.Prelude.Display+      RIO.Prelude.Extra+      RIO.Prelude.IO+      RIO.Prelude.Lens+      RIO.Prelude.Logger+      RIO.Prelude.Reexports+      RIO.Prelude.Renames+      RIO.Prelude.RIO+      RIO.Prelude.Text+      RIO.Prelude.URef       RIO.Process       RIO.Set       RIO.Text@@ -75,7 +86,7 @@       RIO.Vector.Storable       RIO.Vector.Unboxed   other-modules:-      RIO.Prelude+      Paths_rio   default-language: Haskell2010  test-suite spec@@ -96,6 +107,7 @@     , microlens     , mtl     , primitive+    , process     , rio     , text     , time@@ -111,7 +123,9 @@     build-depends:         unix   other-modules:+      RIO.ListSpec       RIO.LoggerSpec       RIO.PreludeSpec+      RIO.TextSpec       Paths_rio   default-language: Haskell2010

@@ -1,5 +1,23 @@-module RIO ( module RIO.Logger-           , module RIO.Prelude) where+module RIO+  ( module RIO.Prelude.Display+  , module RIO.Prelude.Extra+  , module RIO.Prelude.IO+  , module RIO.Prelude.Lens+  , module RIO.Prelude.Logger+  , module RIO.Prelude.RIO+  , module RIO.Prelude.Reexports+  , module RIO.Prelude.Renames+  , module RIO.Prelude.Text+  , module RIO.Prelude.URef+  ) where -import RIO.Prelude-import RIO.Logger+import RIO.Prelude.Display+import RIO.Prelude.Extra+import RIO.Prelude.IO+import RIO.Prelude.Lens+import RIO.Prelude.Logger+import RIO.Prelude.RIO+import RIO.Prelude.Reexports+import RIO.Prelude.Renames+import RIO.Prelude.Text+import RIO.Prelude.URef

@@ -9,7 +9,7 @@  import Data.ByteString hiding (head, last, tail, init, foldl1, foldl1', foldr1, foldr1', maximum, minimum, findSubstring, findSubstrings, packCString, packCStringLen, useAsCString, useAsCStringLen, getLine, getContents, putStr, putStrLn, interact, readFile, writeFile, appendFile, hGetLine, hGetContents, hGet, hGetSome, hGetNonBlocking, hPut, hPutNonBlocking, hPutStr, hPutStrLn, breakByte) import qualified Data.ByteString as B-import RIO.Prelude+import RIO import Foreign.C.String (CString, CStringLen)  -- | Lifted 'B.packCString'

@@ -0,0 +1,8 @@+-- | Unicode @Char@. Import as:+--+-- > import qualified RIO.Char as C+module RIO.Char+  ( module Data.Char+  ) where++import Data.Char

@@ -3,6 +3,38 @@ -- > import qualified RIO.List as L module RIO.List   ( module Data.List+  , stripSuffix+  , dropPrefix+  , dropSuffix   ) where  import Data.List+import Data.Maybe (fromMaybe)++-- | Remove the suffix from the given list, if present+--+-- @since 0.0.0+stripSuffix :: Eq a+            => [a] -- ^ suffix+            -> [a]+            -> Maybe [a]+stripSuffix suffix list =+  fmap reverse (stripPrefix (reverse suffix) (reverse list))++-- | Drop prefix if present, otherwise return original list.+--+-- @since 0.0.0.0+dropPrefix :: Eq a+           => [a] -- ^ prefix+           -> [a]+           -> [a]+dropPrefix prefix t = fromMaybe t (stripPrefix prefix t)++-- | Drop prefix if present, otherwise return original list.+--+-- @since 0.0.0.0+dropSuffix :: Eq a+           => [a] -- ^ suffix+           -> [a]+           -> [a]+dropSuffix suffix t = fromMaybe t (stripSuffix suffix t)

@@ -1,341 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleInstances #-}-module RIO.Logger-  ( LogLevel (..)-  , LogSource-  , LogStr-  , LogFunc-  , CallStack-  , HasLogFunc (..)-  , logGeneric-  , logDebug-  , logInfo-  , logWarn-  , logError-  , logDebugS-  , logInfoS-  , logWarnS-  , logErrorS-  , logOther-  , logSticky-  , logStickyDone-  , runNoLogging-  , NoLogging (..)-  , withStickyLogger-  , LogOptions (..)-  , displayCallStack-  , mkLogOptions-  ) where--import RIO.Prelude-import Data.Text (Text)-import qualified Data.Text as T-import Control.Monad.IO.Class (MonadIO, liftIO)-import Control.Monad.Reader (MonadReader, ReaderT, runReaderT)-import Lens.Micro (to)-import GHC.Stack (HasCallStack, CallStack, SrcLoc (..), getCallStack, callStack)-import Data.Time-import qualified Data.Text.IO as TIO-import Data.ByteString.Builder (toLazyByteString, char7, byteString)-import Data.ByteString.Builder.Extra (flush)-import           GHC.IO.Handle.Internals         (wantWritableHandle)-import           GHC.IO.Encoding.Types           (textEncodingName)-import           GHC.IO.Handle.Types             (Handle__ (..))-import qualified Data.ByteString as B-import           System.IO                  (localeEncoding)-import           GHC.Foreign                (peekCString, withCString)--data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther !Text-    deriving (Eq, Show, Read, Ord)--type LogSource = Text-type LogStr = DisplayBuilder-class HasLogFunc env where-  logFuncL :: SimpleGetter env LogFunc-instance HasLogFunc LogFunc where-  logFuncL = id--type LogFunc = CallStack -> LogSource -> LogLevel -> LogStr -> IO ()--logGeneric-  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)-  => LogSource-  -> LogLevel-  -> LogStr-  -> m ()-logGeneric src level str = do-  logFunc <- view logFuncL-  liftIO $ logFunc callStack src level str--logDebug-  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)-  => LogStr-  -> m ()-logDebug = logGeneric "" LevelDebug--logInfo-  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)-  => LogStr-  -> m ()-logInfo = logGeneric "" LevelInfo--logWarn-  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)-  => LogStr-  -> m ()-logWarn = logGeneric "" LevelWarn--logError-  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)-  => LogStr-  -> m ()-logError = logGeneric "" LevelError--logDebugS-  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)-  => LogSource-  -> LogStr-  -> m ()-logDebugS src = logGeneric src LevelDebug--logInfoS-  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)-  => LogSource-  -> LogStr-  -> m ()-logInfoS src = logGeneric src LevelInfo--logWarnS-  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)-  => LogSource-  -> LogStr-  -> m ()-logWarnS src = logGeneric src LevelWarn--logErrorS-  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)-  => LogSource-  -> LogStr-  -> m ()-logErrorS src = logGeneric src LevelError--logOther-  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)-  => Text -- ^ level-  -> LogStr-  -> m ()-logOther = logGeneric "" . LevelOther--runNoLogging :: MonadIO m => ReaderT NoLogging m a -> m a-runNoLogging = flip runReaderT NoLogging--data NoLogging = NoLogging-instance HasLogFunc NoLogging where-  logFuncL = to (\_ _ _ _ _ -> return ())---- | Write a "sticky" line to the terminal. Any subsequent lines will--- overwrite this one, and that same line will be repeated below--- again. In other words, the line sticks at the bottom of the output--- forever. Running this function again will replace the sticky line--- with a new sticky line. When you want to get rid of the sticky--- line, run 'logStickyDone'.----logSticky :: (MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) => LogStr -> m ()-logSticky = logOther "sticky"---- | This will print out the given message with a newline and disable--- any further stickiness of the line until a new call to 'logSticky'--- happens.------ It might be better at some point to have a 'runSticky' function--- that encompasses the logSticky->logStickyDone pairing.-logStickyDone :: (MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) => LogStr -> m ()-logStickyDone = logOther "sticky-done"--canUseUtf8 :: MonadIO m => Handle -> m Bool-canUseUtf8 h = liftIO $ wantWritableHandle "canUseUtf8" h $ \h_ -> do-  -- TODO also handle haOutputNL for CRLF-  return $ (textEncodingName <$> haCodec h_) == Just "UTF-8"--mkLogOptions-  :: MonadIO m-  => Handle-  -> Bool -- ^ verbose?-  -> m LogOptions-mkLogOptions handle verbose = liftIO $ do-  terminal <- hIsTerminalDevice handle-  useUtf8 <- canUseUtf8 handle-  unicode <- if useUtf8 then return True else getCanUseUnicode-  return LogOptions-    { logMinLevel = if verbose then LevelDebug else LevelInfo-    , logVerboseFormat = verbose-    , logTerminal = terminal-    , logUseTime = verbose-    , logUseColor = verbose-    , logSend = \builder ->-        if useUtf8 && unicode-          then hPutBuilder handle (builder <> flush)-          else do-            let lbs = toLazyByteString builder-                bs = toStrictBytes lbs-            case decodeUtf8' bs of-              Left e -> error $ "mkLogOptions: invalid UTF8 sequence: " ++ show (e, bs)-              Right text -> do-                let text'-                      | unicode = text-                      | otherwise = T.map replaceUnicode text-                TIO.hPutStr handle text'-                hFlush handle-    }---- | Taken from GHC: determine if we should use Unicode syntax-getCanUseUnicode :: IO Bool-getCanUseUnicode = do-    let enc = localeEncoding-        str = "\x2018\x2019"-        test = withCString enc str $ \cstr -> do-            str' <- peekCString enc cstr-            return (str == str')-    test `catchIO` \_ -> return False--withStickyLogger :: MonadUnliftIO m => LogOptions -> (LogFunc -> m a) -> m a-withStickyLogger options inner = withRunInIO $ \run -> do-  if logTerminal options-    then withSticky options $ \var ->-           run $ inner $ stickyImpl var options (simpleLogFunc options)-    else-      run $ inner $ \cs src level str ->-      simpleLogFunc options cs src (noSticky level) str---- | Replace Unicode characters with non-Unicode equivalents-replaceUnicode :: Char -> Char-replaceUnicode '\x2018' = '`'-replaceUnicode '\x2019' = '\''-replaceUnicode c = c--noSticky :: LogLevel -> LogLevel-noSticky (LevelOther "sticky-done") = LevelInfo-noSticky (LevelOther "sticky") = LevelInfo-noSticky level = level--data LogOptions = LogOptions-  { logMinLevel :: !LogLevel-  , logVerboseFormat :: !Bool-  , logTerminal :: !Bool-  , logUseTime :: !Bool-  , logUseColor :: !Bool-  , logSend :: !(Builder -> IO ())-  }--simpleLogFunc :: LogOptions -> LogFunc-simpleLogFunc lo cs _src level msg =-    when (level >= logMinLevel lo) $ do-      timestamp <- getTimestamp-      logSend lo $ getUtf8Builder $-        timestamp <>-        getLevel <>-        ansi reset <>-        msg <>-        getLoc <>-        ansi reset <>-        "\n"-  where-   reset = "\ESC[0m"-   setBlack = "\ESC[90m"-   setGreen = "\ESC[32m"-   setBlue = "\ESC[34m"-   setYellow = "\ESC[33m"-   setRed = "\ESC[31m"-   setMagenta = "\ESC[35m"--   ansi :: DisplayBuilder -> DisplayBuilder-   ansi xs | logUseColor lo = xs-           | otherwise = mempty--   getTimestamp :: IO DisplayBuilder-   getTimestamp-     | logVerboseFormat lo && logUseTime lo =-       do now <- getZonedTime-          return $ ansi setBlack <> fromString (formatTime' now) <> ": "-     | otherwise = return mempty-     where-       formatTime' =-           take timestampLength . formatTime defaultTimeLocale "%F %T.%q"--   getLevel :: DisplayBuilder-   getLevel-     | logVerboseFormat lo =-         case level of-           LevelDebug -> ansi setGreen <> "[debug] "-           LevelInfo -> ansi setBlue <> "[info] "-           LevelWarn -> ansi setYellow <> "[warn] "-           LevelError -> ansi setRed <> "[error] "-           LevelOther name ->-             ansi setMagenta <>-             "[" <>-             display name <>-             "] "-     | otherwise = mempty--   getLoc :: DisplayBuilder-   getLoc-     | logVerboseFormat lo = ansi setBlack <> "\n@(" <> displayCallStack cs <> ")"-     | otherwise = mempty--displayCallStack :: CallStack -> DisplayBuilder-displayCallStack cs =-     case reverse $ getCallStack cs of-       [] -> "<no call stack found>"-       (_desc, loc):_ ->-         let file = srcLocFile loc-          in fromString file <>-             ":" <>-             displayShow (srcLocStartLine loc) <>-             ":" <>-             displayShow (srcLocStartCol loc)---- | The length of a timestamp in the format "YYYY-MM-DD hh:mm:ss.μμμμμμ".--- This definition is top-level in order to avoid multiple reevaluation at runtime.-timestampLength :: Int-timestampLength =-  length (formatTime defaultTimeLocale "%F %T.000000" (UTCTime (ModifiedJulianDay 0) 0))--stickyImpl-    :: MVar ByteString -> LogOptions -> LogFunc-    -> (CallStack -> LogSource -> LogLevel -> LogStr -> IO ())-stickyImpl ref lo logFunc loc src level msgOrig = modifyMVar_ ref $ \sticky -> do-  let backSpaceChar = '\8'-      repeating = mconcat . replicate (B.length sticky) . char7-      clear = logSend lo-        (repeating backSpaceChar <>-        repeating ' ' <>-        repeating backSpaceChar)--  case level of-    LevelOther "sticky-done" -> do-      clear-      logFunc loc src LevelInfo msgOrig-      return mempty-    LevelOther "sticky" -> do-      clear-      let bs = toStrictBytes $ toLazyByteString $ getUtf8Builder msgOrig-      logSend lo (byteString bs <> flush)-      return bs-    _-      | level >= logMinLevel lo -> do-          clear-          logFunc loc src level msgOrig-          unless (B.null sticky) $ logSend lo (byteString sticky <> flush)-          return sticky-      | otherwise -> return sticky---- | With a sticky state, do the thing.-withSticky :: LogOptions -> (MVar ByteString -> IO b) -> IO b-withSticky lo inner = bracket-  (newMVar mempty)-  (\state -> do-      state' <- takeMVar state-      unless (B.null state') (logSend lo "\n"))-  inner

@@ -1,583 +0,0 @@-{-# LANGUAGE BangPatterns               #-}-{-# LANGUAGE CPP                        #-}-{-# LANGUAGE ConstraintKinds            #-}-{-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE NoImplicitPrelude          #-}-{-# LANGUAGE OverloadedStrings          #-}-{-# LANGUAGE TypeSynonymInstances       #-}-module RIO.Prelude-  ( module UnliftIO-  , UnliftIO.Concurrent.threadDelay-  , mapLeft-  , withLazyFile-  , fromFirst-  , mapMaybeA-  , mapMaybeM-  , forMaybeA-  , forMaybeM-  , stripCR-  , RIO (..)-  , runRIO-  , liftRIO-  , tshow-  , nubOrd-  , readFileBinary-  , writeFileBinary-  , ReadFileUtf8Exception (..)-  , readFileUtf8-  , writeFileUtf8-  , LByteString-  , toStrictBytes-  , fromStrictBytes-  , decodeUtf8Lenient-  , LText-  , view-  , UVector-  , SVector-  , GVector-  , DisplayBuilder (..)-  , Display (..)-  , displayShow-  , displayBuilderToText-  , displayBytesUtf8-  , writeFileDisplayBuilder-  , hPutBuilder-  , sappend-  , Control.Applicative.Alternative-  , Control.Applicative.Applicative (..)-  , Control.Applicative.liftA-#if !MIN_VERSION_base(4, 10, 0)-  , Control.Applicative.liftA2-#endif-  , Control.Applicative.liftA3-  , Control.Applicative.many-  , Control.Applicative.optional-  , Control.Applicative.some-  , (Control.Applicative.<|>)-  , Control.Arrow.first-  , Control.Arrow.second-  , (Control.Arrow.&&&)-  , (Control.Arrow.***)-  , Control.DeepSeq.NFData(..)-  , Control.DeepSeq.force-  , (Control.DeepSeq.$!!)-  , Control.Monad.Monad(..)-  , Control.Monad.MonadPlus(..)-  , Control.Monad.filterM-  , Control.Monad.foldM-  , Control.Monad.foldM_-  , Control.Monad.forever-  , Control.Monad.guard-  , Control.Monad.join-  , Control.Monad.liftM-  , Control.Monad.liftM2-  , Control.Monad.replicateM_-  , Control.Monad.unless-  , Control.Monad.when-  , Control.Monad.zipWithM-  , Control.Monad.zipWithM_-  , (Control.Monad.<$!>)-  , (Control.Monad.<=<)-  , (Control.Monad.=<<)-  , (Control.Monad.>=>)-  , Control.Monad.Catch.MonadThrow(..)-  , Control.Monad.Reader.MonadReader-  , Control.Monad.Reader.MonadTrans(..)-  , Control.Monad.Reader.ReaderT(..)-  , Control.Monad.Reader.ask-  , Control.Monad.Reader.asks-  , Control.Monad.Reader.local-  , Data.Bool.Bool(..)-  , Data.Bool.not-  , Data.Bool.otherwise-  , (Data.Bool.&&)-  , (Data.Bool.||)-  , Data.ByteString.ByteString-  , Data.ByteString.Builder.Builder-  , Data.ByteString.Short.ShortByteString-  , Data.ByteString.Short.toShort-  , Data.ByteString.Short.fromShort-  , Data.Char.Char-  , Data.Data.Data(..)-  , Data.Either.Either(..)-  , Data.Either.either-  , Data.Either.isLeft-  , Data.Either.isRight-  , Data.Either.lefts-  , Data.Either.partitionEithers-  , Data.Either.rights-  , Data.Eq.Eq(..)-  , Data.Foldable.Foldable-  , Data.Foldable.all-  , Data.Foldable.and-  , Data.Foldable.any-  , Data.Foldable.asum-  , Data.Foldable.concat-  , Data.Foldable.concatMap-  , Data.Foldable.elem-  , Data.Foldable.fold-  , Data.Foldable.foldMap-  , Data.Foldable.foldl'-  , Data.Foldable.foldr-  , Data.Foldable.forM_-  , Data.Foldable.for_-  , Data.Foldable.length-  , Data.Foldable.mapM_-  , Data.Foldable.msum-  , Data.Foldable.notElem-  , Data.Foldable.null-  , Data.Foldable.or-  , Data.Foldable.product-  , Data.Foldable.sequenceA_-  , Data.Foldable.sequence_-  , Data.Foldable.sum-  , Data.Foldable.toList-  , Data.Foldable.traverse_-  , Data.Function.const-  , Data.Function.fix-  , Data.Function.flip-  , Data.Function.id-  , Data.Function.on-  , (Data.Function.$)-  , (Data.Function.&)-  , (Data.Function..)-  , Data.Functor.Functor(..)-  , Data.Functor.void-  , (Data.Functor.$>)-  , (Data.Functor.<$>)-  , Data.Hashable.Hashable-  , Data.HashMap.Strict.HashMap-  , Data.HashSet.HashSet-  , Data.Int.Int-  , Data.Int.Int8-  , Data.Int.Int16-  , Data.Int.Int32-  , Data.Int.Int64-  , Data.IntMap.Strict.IntMap-  , Data.IntSet.IntSet-  , Data.List.break-  , Data.List.drop-  , Data.List.dropWhile-  , Data.List.filter-  , Data.List.lines-  , Data.List.lookup-  , Data.List.map-  , Data.List.replicate-  , Data.List.reverse-  , Data.List.span-  , Data.List.take-  , Data.List.takeWhile-  , Data.List.unlines-  , Data.List.unwords-  , Data.List.words-  , Data.List.zip-  , (Data.List.++)-  , Data.Map.Strict.Map-  , Data.Maybe.Maybe(..)-  , Data.Maybe.catMaybes-  , Data.Maybe.fromMaybe-  , Data.Maybe.isJust-  , Data.Maybe.isNothing-  , Data.Maybe.listToMaybe-  , Data.Maybe.mapMaybe-  , Data.Maybe.maybe-  , Data.Maybe.maybeToList-  , Data.Monoid.All (..)-  , Data.Monoid.Any (..)-  , Data.Monoid.Endo (..)-  , Data.Monoid.First (..)-  , Data.Monoid.Last (..)-  , Data.Monoid.Monoid (..)-  , Data.Monoid.Product (..)-  , Data.Monoid.Sum (..)-  , (Data.Monoid.<>)-  , Data.Ord.Ord(..)-  , Data.Ord.Ordering(..)-  , Data.Ord.comparing-  , Data.Semigroup.Semigroup-  , Data.Set.Set-  , Data.String.IsString(..)-  , Data.Text.Text-  , Data.Text.Encoding.decodeUtf8'-  , Data.Text.Encoding.decodeUtf8With-  , Data.Text.Encoding.encodeUtf8-  , Data.Text.Encoding.encodeUtf8Builder-  , Data.Text.Encoding.Error.UnicodeException(..)-  , Data.Text.Encoding.Error.lenientDecode-  , Data.Traversable.Traversable(..)-  , Data.Traversable.for-  , Data.Traversable.forM-  , Data.Vector.Vector-  , Data.Void.Void-  , Data.Void.absurd-  , Data.Word.Word-  , Data.Word.Word8-  , Data.Word.Word16-  , Data.Word.Word32-  , Data.Word.Word64-  , Data.Word.byteSwap16-  , Data.Word.byteSwap32-  , Data.Word.byteSwap64-  , Foreign.Storable.Storable-  , GHC.Generics.Generic-  , GHC.Stack.HasCallStack-  , Lens.Micro.ASetter-  , Lens.Micro.ASetter'-  , Lens.Micro.Getting-  , Lens.Micro.Lens-  , Lens.Micro.Lens'-  , Lens.Micro.SimpleGetter-  , Lens.Micro.lens-  , Lens.Micro.over-  , Lens.Micro.set-  , Lens.Micro.sets-  , Lens.Micro.to-  , (Lens.Micro.^.)-  , Prelude.Bounded (..)-  , Prelude.Double-  , Prelude.Enum-  , Prelude.FilePath-  , Prelude.Float-  , Prelude.Floating (..)-  , Prelude.Fractional (..)-  , Prelude.IO-  , Prelude.Integer-  , Prelude.Integral (..)-  , Prelude.Num (..)-  , Prelude.Rational-  , Prelude.Real (..)-  , Prelude.RealFloat (..)-  , Prelude.RealFrac (..)-  , Prelude.Show-  , Prelude.String-  , Prelude.asTypeOf-  , Prelude.curry-  , Prelude.error-  , Prelude.even-  , Prelude.fromIntegral-  , Prelude.fst-  , Prelude.gcd-  , Prelude.lcm-  , Prelude.odd-  , Prelude.realToFrac-  , Prelude.seq-  , Prelude.show-  , Prelude.snd-  , Prelude.subtract-  , Prelude.uncurry-  , Prelude.undefined-  , (Prelude.$!)-  , (Prelude.^)-  , (Prelude.^^)-  , System.Exit.ExitCode(..)-  , Text.Read.Read-  , Text.Read.readMaybe-    -- * Primitive-  , PrimMonad (..)-    -- * Unboxed references-  , Unbox-  , URef-  , IOURef-  , newURef-  , readURef-  , writeURef-  , modifyURef-  -- List imports from UnliftIO?-  ) where---- Fixed imports go here-import           Control.Applicative      (Applicative)-import           Control.Monad            (Monad (..), liftM, (<=<))-import           Control.Monad.Catch      (MonadThrow)-import           Control.Monad.Primitive  (PrimMonad (..))-import           Control.Monad.Reader     (MonadReader, ReaderT (..), ask, asks)-import           Data.Bool                (otherwise)-import           Data.ByteString          (ByteString)-import           Data.ByteString.Builder  (Builder)-import           Data.Either              (Either (..))-import           Data.Foldable            (foldMap)-import           Data.Function            (flip, ($), (.))-import           Data.Functor             (Functor (..))-import           Data.Int                 (Int)-import           Data.Maybe               (Maybe, catMaybes, fromMaybe)-import           Data.Monoid              (First (..), Monoid (..))-import           Data.Ord                 (Ord)-import           Data.Semigroup           (Semigroup)-import           Data.String              (IsString (..))-import           Data.Text                (Text)-import           Data.Text.Encoding       (decodeUtf8', decodeUtf8With,-                                           encodeUtf8, encodeUtf8Builder)-import           Data.Text.Encoding.Error (UnicodeException, lenientDecode)-import           Data.Traversable         (Traversable (..))-import           Lens.Micro               (Getting)-import           Prelude                  (FilePath, IO, Show (..))-import           UnliftIO-import qualified UnliftIO.Concurrent--- import           UnliftIO                 (Exception, Handle, IOMode (..),---                                            MonadIO (..), MonadUnliftIO,---                                            Typeable, UnliftIO (..), throwIO,---                                            withBinaryFile, withUnliftIO)--import qualified Data.Text                as T-import qualified Data.Text.Lazy           as TL--import qualified Data.ByteString          as B-import qualified Data.ByteString.Lazy     as BL--import qualified Data.Vector.Generic      as GVector-import qualified Data.Vector.Storable     as SVector-import qualified Data.Vector.Unboxed      as UVector-import qualified Data.Vector.Unboxed.Mutable as MUVector-import           Data.Vector.Unboxed.Mutable (Unbox)--import qualified Data.ByteString.Builder  as BB-import qualified Data.Semigroup--import           Control.Applicative      (Const (..))-import           Lens.Micro.Internal      (( #. ))--import qualified Data.Set                 as Set---- Reexports-import qualified Control.Applicative-import qualified Control.Arrow-import qualified Control.DeepSeq-import qualified Control.Monad-import qualified Control.Monad.Catch-import qualified Control.Monad.Reader-import qualified Data.Bool-import qualified Data.ByteString-import qualified Data.ByteString.Builder-import qualified Data.ByteString.Short-import qualified Data.Char-import qualified Data.Data-import qualified Data.Either-import qualified Data.Eq-import qualified Data.Foldable-import qualified Data.Function-import qualified Data.Functor-import qualified Data.Hashable-import qualified Data.HashMap.Strict-import qualified Data.HashSet-import qualified Data.Int-import qualified Data.IntMap.Strict-import qualified Data.IntSet-import qualified Data.List-import qualified Data.Map.Strict-import qualified Data.Maybe-import qualified Data.Monoid-import qualified Data.Ord-import qualified Data.Semigroup-import qualified Data.Set-import qualified Data.String-import qualified Data.Text-import qualified Data.Text.Encoding-import qualified Data.Text.Encoding.Error-import qualified Data.Traversable-import qualified Data.Vector-import qualified Data.Void-import qualified Data.Word-import qualified Foreign.Storable-import qualified GHC.Generics-import qualified GHC.Stack-import qualified Lens.Micro-import qualified Prelude-import qualified System.Exit-import qualified Text.Read-import qualified UnliftIO---mapLeft :: (a1 -> a2) -> Either a1 b -> Either a2 b-mapLeft f (Left a1) = Left (f a1)-mapLeft _ (Right b) = Right b--fromFirst :: a -> First a -> a-fromFirst x = fromMaybe x . getFirst---- | Applicative 'mapMaybe'.-mapMaybeA :: Applicative f => (a -> f (Maybe b)) -> [a] -> f [b]-mapMaybeA f = fmap catMaybes . traverse f---- | @'forMaybeA' '==' 'flip' 'mapMaybeA'@-forMaybeA :: Applicative f => [a] -> (a -> f (Maybe b)) -> f [b]-forMaybeA = flip mapMaybeA---- | Monadic 'mapMaybe'.-mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]-mapMaybeM f = liftM catMaybes . mapM f---- | @'forMaybeM' '==' 'flip' 'mapMaybeM'@-forMaybeM :: Monad m => [a] -> (a -> m (Maybe b)) -> m [b]-forMaybeM = flip mapMaybeM---- | Strip trailing carriage return from Text-stripCR :: T.Text -> T.Text-stripCR t = fromMaybe t (T.stripSuffix "\r" t)---- | Lazily get the contents of a file. Unlike 'BL.readFile', this--- ensures that if an exception is thrown, the file handle is closed--- immediately.-withLazyFile :: MonadUnliftIO m => FilePath -> (BL.ByteString -> m a) -> m a-withLazyFile fp inner = withBinaryFile fp ReadMode $ inner <=< liftIO . BL.hGetContents---- | The Reader+IO monad. This is different from a 'ReaderT' because:------ * It's not a transformer, it hardcodes IO for simpler usage and--- error messages.------ * Instances of typeclasses like 'MonadLogger' are implemented using--- classes defined on the environment, instead of using an--- underlying monad.-newtype RIO env a = RIO { unRIO :: ReaderT env IO a }-  deriving (Functor,Applicative,Monad,MonadIO,MonadReader env,MonadThrow)--runRIO :: MonadIO m => env -> RIO env a -> m a-runRIO env (RIO (ReaderT f)) = liftIO (f env)--liftRIO :: (MonadIO m, MonadReader env m) => RIO env a -> m a-liftRIO rio = do-  env <- ask-  runRIO env rio--instance MonadUnliftIO (RIO env) where-    askUnliftIO = RIO $ ReaderT $ \r ->-                  withUnliftIO $ \u ->-                  return (UnliftIO (unliftIO u . flip runReaderT r . unRIO))--tshow :: Show a => a -> Text-tshow = T.pack . show--nubOrd :: Ord a => [a] -> [a]-nubOrd =-  loop mempty-  where-    loop _ [] = []-    loop !s (a:as)-      | a `Set.member` s = loop s as-      | otherwise = a : loop (Set.insert a s) as---- | Same as 'B.readFile', but generalized to 'MonadIO'-readFileBinary :: MonadIO m => FilePath -> m ByteString-readFileBinary = liftIO . B.readFile---- | Same as 'B.writeFile', but generalized to 'MonadIO'-writeFileBinary :: MonadIO m => FilePath -> ByteString -> m ()-writeFileBinary fp = liftIO . B.writeFile fp---- | Read a file in UTF8 encoding, throwing an exception on invalid character--- encoding.-readFileUtf8 :: MonadIO m => FilePath -> m Text-readFileUtf8 fp = do-  bs <- readFileBinary fp-  case decodeUtf8' bs of-    Left e     -> throwIO $ ReadFileUtf8Exception fp e-    Right text -> return text--data ReadFileUtf8Exception = ReadFileUtf8Exception !FilePath !UnicodeException-  deriving (Show, Typeable)-instance Exception ReadFileUtf8Exception---- | Write a file in UTF8 encoding-writeFileUtf8 :: MonadIO m => FilePath -> Text -> m ()-writeFileUtf8 fp = writeFileBinary fp . encodeUtf8--type LByteString = BL.ByteString--toStrictBytes :: LByteString -> ByteString-toStrictBytes = BL.toStrict--fromStrictBytes :: ByteString -> LByteString-fromStrictBytes = BL.fromStrict--view :: MonadReader s m => Getting a s a -> m a-view l = asks (getConst #. l Const)--type UVector = UVector.Vector-type SVector = SVector.Vector-type GVector = GVector.Vector--decodeUtf8Lenient :: ByteString -> Text-decodeUtf8Lenient = decodeUtf8With lenientDecode--type LText = TL.Text--newtype DisplayBuilder = DisplayBuilder { getUtf8Builder :: Builder }-  deriving (Semigroup, Monoid)--instance IsString DisplayBuilder where-  fromString = DisplayBuilder . BB.stringUtf8--class Display a where-  display :: a -> DisplayBuilder-instance Display Text where-  display = DisplayBuilder . encodeUtf8Builder-instance Display LText where-  display = foldMap display . TL.toChunks-instance Display Int where-  display = DisplayBuilder . BB.intDec--displayShow :: Show a => a -> DisplayBuilder-displayShow = fromString . show--displayBytesUtf8 :: ByteString -> DisplayBuilder-displayBytesUtf8 = DisplayBuilder . BB.byteString--displayBuilderToText :: DisplayBuilder -> Text-displayBuilderToText =-  decodeUtf8With lenientDecode . BL.toStrict . BB.toLazyByteString . getUtf8Builder--sappend :: Semigroup s => s -> s -> s-sappend = (Data.Semigroup.<>)--writeFileDisplayBuilder :: MonadIO m => FilePath -> DisplayBuilder -> m ()-writeFileDisplayBuilder fp (DisplayBuilder builder) =-  liftIO $ withBinaryFile fp WriteMode $ \h -> hPutBuilder h builder--hPutBuilder :: MonadIO m => Handle -> Builder -> m ()-hPutBuilder h = liftIO . BB.hPutBuilder h-{-# INLINE hPutBuilder #-}---- | An unboxed reference. This works like an 'IORef', but the data is--- stored in a bytearray instead of a heap object, avoiding--- significant allocation overhead in some cases. For a concrete--- example, see this Stack Overflow question:--- <https://stackoverflow.com/questions/27261813/why-is-my-little-stref-int-require-allocating-gigabytes>.------ The first parameter is the state token type, the same as would be--- used for the 'ST' monad. If you're using an 'IO'-based monad, you--- can use the convenience 'IOURef' type synonym instead.------ @since 0.0.2.0-newtype URef s a = URef (MUVector.MVector s a)---- | Helpful type synonym for using a 'URef' from an 'IO'-based stack.------ @since 0.0.2.0-type IOURef = URef (PrimState IO)---- | Create a new 'URef'------ @since 0.0.2.0-newURef :: (PrimMonad m, Unbox a) => a -> m (URef (PrimState m) a)-newURef a = fmap URef (MUVector.replicate 1 a)---- | Read the value in a 'URef'------ @since 0.0.2.0-readURef :: (PrimMonad m, Unbox a) => URef (PrimState m) a -> m a-readURef (URef v) = MUVector.unsafeRead v 0---- | Write a value into a 'URef'. Note that this action is strict, and--- will force evalution of the value.------ @since 0.0.2.0-writeURef :: (PrimMonad m, Unbox a) => URef (PrimState m) a -> a -> m ()-writeURef (URef v) = MUVector.unsafeWrite v 0---- | Modify a value in a 'URef'. Note that this action is strict, and--- will force evaluation of the result value.------ @since 0.0.2.0-modifyURef :: (PrimMonad m, Unbox a) => URef (PrimState m) a -> (a -> a) -> m ()-modifyURef u f = readURef u >>= writeURef u . f

@@ -0,0 +1,50 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module RIO.Prelude.Display+  ( DisplayBuilder (..)+  , Display (..)+  , displayShow+  , displayBuilderToText+  , displayBytesUtf8+  , writeFileDisplayBuilder+  ) where++import Data.String (IsString (..))+import           Data.ByteString          (ByteString)+import qualified Data.ByteString.Lazy     as BL+import qualified Data.ByteString.Builder  as BB+import           Data.ByteString.Builder  (Builder)+import           Data.Semigroup           (Semigroup)+import           Data.Text                (Text)+import qualified Data.Text.Lazy           as TL+import UnliftIO+import           Data.Text.Encoding       (decodeUtf8With, encodeUtf8Builder)+import           Data.Text.Encoding.Error (lenientDecode)++newtype DisplayBuilder = DisplayBuilder { getUtf8Builder :: Builder }+  deriving (Semigroup, Monoid)++instance IsString DisplayBuilder where+  fromString = DisplayBuilder . BB.stringUtf8++class Display a where+  display :: a -> DisplayBuilder+instance Display Text where+  display = DisplayBuilder . encodeUtf8Builder+instance Display TL.Text where+  display = foldMap display . TL.toChunks+instance Display Int where+  display = DisplayBuilder . BB.intDec++displayShow :: Show a => a -> DisplayBuilder+displayShow = fromString . show++displayBytesUtf8 :: ByteString -> DisplayBuilder+displayBytesUtf8 = DisplayBuilder . BB.byteString++displayBuilderToText :: DisplayBuilder -> Text+displayBuilderToText =+  decodeUtf8With lenientDecode . BL.toStrict . BB.toLazyByteString . getUtf8Builder++writeFileDisplayBuilder :: MonadIO m => FilePath -> DisplayBuilder -> m ()+writeFileDisplayBuilder fp (DisplayBuilder builder) =+  liftIO $ withBinaryFile fp WriteMode $ \h -> BB.hPutBuilder h builder

@@ -0,0 +1,46 @@+{-# LANGUAGE BangPatterns #-}+module RIO.Prelude.Extra+  ( mapLeft+  , fromFirst+  , mapMaybeA+  , mapMaybeM+  , forMaybeA+  , forMaybeM+  , nubOrd+  ) where++import qualified Data.Set as Set+import Data.Monoid (First (..))+import RIO.Prelude.Reexports++mapLeft :: (a1 -> a2) -> Either a1 b -> Either a2 b+mapLeft f (Left a1) = Left (f a1)+mapLeft _ (Right b) = Right b++fromFirst :: a -> First a -> a+fromFirst x = fromMaybe x . getFirst++-- | Applicative 'mapMaybe'.+mapMaybeA :: Applicative f => (a -> f (Maybe b)) -> [a] -> f [b]+mapMaybeA f = fmap catMaybes . traverse f++-- | @'forMaybeA' '==' 'flip' 'mapMaybeA'@+forMaybeA :: Applicative f => [a] -> (a -> f (Maybe b)) -> f [b]+forMaybeA = flip mapMaybeA++-- | Monadic 'mapMaybe'.+mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]+mapMaybeM f = liftM catMaybes . mapM f++-- | @'forMaybeM' '==' 'flip' 'mapMaybeM'@+forMaybeM :: Monad m => [a] -> (a -> m (Maybe b)) -> m [b]+forMaybeM = flip mapMaybeM++nubOrd :: Ord a => [a] -> [a]+nubOrd =+  loop mempty+  where+    loop _ [] = []+    loop !s (a:as)+      | a `Set.member` s = loop s as+      | otherwise = a : loop (Set.insert a s) as

@@ -0,0 +1,49 @@+module RIO.Prelude.IO+  ( withLazyFile+  , readFileBinary+  , writeFileBinary+  , ReadFileUtf8Exception (..)+  , readFileUtf8+  , writeFileUtf8+  , hPutBuilder+  ) where++import RIO.Prelude.Reexports+import qualified Data.ByteString.Builder  as BB+import qualified Data.ByteString          as B+import qualified Data.ByteString.Lazy     as BL++-- | Lazily get the contents of a file. Unlike 'BL.readFile', this+-- ensures that if an exception is thrown, the file handle is closed+-- immediately.+withLazyFile :: MonadUnliftIO m => FilePath -> (BL.ByteString -> m a) -> m a+withLazyFile fp inner = withBinaryFile fp ReadMode $ inner <=< liftIO . BL.hGetContents++data ReadFileUtf8Exception = ReadFileUtf8Exception !FilePath !UnicodeException+  deriving (Show, Typeable)+instance Exception ReadFileUtf8Exception++-- | Write a file in UTF8 encoding+writeFileUtf8 :: MonadIO m => FilePath -> Text -> m ()+writeFileUtf8 fp = writeFileBinary fp . encodeUtf8++hPutBuilder :: MonadIO m => Handle -> Builder -> m ()+hPutBuilder h = liftIO . BB.hPutBuilder h+{-# INLINE hPutBuilder #-}++-- | Same as 'B.readFile', but generalized to 'MonadIO'+readFileBinary :: MonadIO m => FilePath -> m ByteString+readFileBinary = liftIO . B.readFile++-- | Same as 'B.writeFile', but generalized to 'MonadIO'+writeFileBinary :: MonadIO m => FilePath -> ByteString -> m ()+writeFileBinary fp = liftIO . B.writeFile fp++-- | Read a file in UTF8 encoding, throwing an exception on invalid character+-- encoding.+readFileUtf8 :: MonadIO m => FilePath -> m Text+readFileUtf8 fp = do+  bs <- readFileBinary fp+  case decodeUtf8' bs of+    Left e     -> throwIO $ ReadFileUtf8Exception fp e+    Right text -> return text

@@ -0,0 +1,23 @@+module RIO.Prelude.Lens+  ( view+  , Lens.Micro.ASetter+  , Lens.Micro.ASetter'+  , Lens.Micro.Getting+  , Lens.Micro.Lens+  , Lens.Micro.Lens'+  , Lens.Micro.SimpleGetter+  , Lens.Micro.lens+  , Lens.Micro.over+  , Lens.Micro.set+  , Lens.Micro.sets+  , Lens.Micro.to+  , (Lens.Micro.^.)+  ) where++import Lens.Micro+import Control.Monad.Reader (MonadReader, asks)+import           Lens.Micro.Internal      (( #. ))+import           Control.Applicative      (Const (..))++view :: MonadReader s m => Getting a s a -> m a+view l = asks (getConst #. l Const)

@@ -0,0 +1,530 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}+module RIO.Prelude.Logger+  ( -- * Standard logging functions+    logDebug+  , logInfo+  , logWarn+  , logError+  , logOther+    -- * Running with logging+  , withLogFunc+  , LogFunc+  , HasLogFunc (..)+  , logOptionsHandle+    -- ** Log options+  , LogOptions+  , setLogMinLevel+  , setLogVerboseFormat+  , setLogTerminal+  , setLogUseTime+  , setLogUseColor+    -- * Advanced logging functions+    -- ** Sticky logging+  , logSticky+  , logStickyDone+    -- ** With source+  , logDebugS+  , logInfoS+  , logWarnS+  , logErrorS+  , logOtherS+    -- ** Generic log function+  , logGeneric+    -- * Advanced running functions+  , mkLogFunc+  , logOptionsMemory+    -- * Data types+  , LogLevel (..)+  , LogSource+  , CallStack+    -- * Convenience functions+  , displayCallStack+  ) where++import RIO.Prelude.Reexports hiding ((<>))+import RIO.Prelude.Renames+import RIO.Prelude.Display+import RIO.Prelude.Lens+import Data.Text (Text)+import qualified Data.Text as T+import Control.Monad.IO.Class (MonadIO, liftIO)+import GHC.Stack (HasCallStack, CallStack, SrcLoc (..), getCallStack, callStack)+import Data.Time+import qualified Data.Text.IO as TIO+import Data.ByteString.Builder (toLazyByteString, char7, byteString, hPutBuilder)+import Data.ByteString.Builder.Extra (flush)+import           GHC.IO.Handle.Internals         (wantWritableHandle)+import           GHC.IO.Encoding.Types           (textEncodingName)+import           GHC.IO.Handle.Types             (Handle__ (..))+import qualified Data.ByteString as B+import           System.IO                  (localeEncoding)+import           GHC.Foreign                (peekCString, withCString)+import Data.Semigroup (Semigroup (..))++-- | The log level of a message.+--+-- @since 0.0.0.0+data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther !Text+    deriving (Eq, Show, Read, Ord)++-- | Where in the application a log message came from. Used for+-- display purposes only.+--+-- @since 0.0.0.0+type LogSource = Text++-- | Environment values with a logging function.+--+-- @since 0.0.0.0+class HasLogFunc env where+  logFuncL :: Lens' env LogFunc+instance HasLogFunc LogFunc where+  logFuncL = id++-- | A logging function, wrapped in a newtype for better error messages.+--+-- An implementation may choose any behavior of this value it wishes,+-- including printing to standard output or no action at all.+--+-- @since 0.0.0.0+newtype LogFunc = LogFunc+  { _unLogFunc :: CallStack -> LogSource -> LogLevel -> DisplayBuilder -> IO ()+  }++-- | Perform both sets of actions per log entry.+--+-- @since 0.0.0.0+instance Semigroup LogFunc where+  LogFunc f <> LogFunc g = LogFunc $ \a b c d -> f a b c d *> g a b c d++-- | 'mempty' peforms no logging.+--+-- @since 0.0.0.0+instance Monoid LogFunc where+  mempty = LogFunc $ \_ _ _ _ -> return ()+  mappend = (<>)++-- | Create a 'LogFunc' from the given function.+--+-- @since 0.0.0.0+mkLogFunc :: (CallStack -> LogSource -> LogLevel -> DisplayBuilder -> IO ()) -> LogFunc+mkLogFunc = LogFunc++-- | Generic, basic function for creating other logging functions.+--+-- @since 0.0.0.0+logGeneric+  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)+  => LogSource+  -> LogLevel+  -> DisplayBuilder+  -> m ()+logGeneric src level str = do+  LogFunc logFunc <- view logFuncL+  liftIO $ logFunc callStack src level str++-- | Log a debug level message with no source.+--+-- @since 0.0.0.0+logDebug+  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)+  => DisplayBuilder+  -> m ()+logDebug = logGeneric "" LevelDebug++-- | Log an info level message with no source.+--+-- @since 0.0.0.0+logInfo+  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)+  => DisplayBuilder+  -> m ()+logInfo = logGeneric "" LevelInfo++-- | Log a warn level message with no source.+--+-- @since 0.0.0.0+logWarn+  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)+  => DisplayBuilder+  -> m ()+logWarn = logGeneric "" LevelWarn++-- | Log an error level message with no source.+--+-- @since 0.0.0.0+logError+  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)+  => DisplayBuilder+  -> m ()+logError = logGeneric "" LevelError++-- | Log a message with the specified textual level and no source.+--+-- @since 0.0.0.0+logOther+  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)+  => Text -- ^ level+  -> DisplayBuilder+  -> m ()+logOther = logGeneric "" . LevelOther++-- | Log a debug level message with the given source.+--+-- @since 0.0.0.0+logDebugS+  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)+  => LogSource+  -> DisplayBuilder+  -> m ()+logDebugS src = logGeneric src LevelDebug++-- | Log an info level message with the given source.+--+-- @since 0.0.0.0+logInfoS+  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)+  => LogSource+  -> DisplayBuilder+  -> m ()+logInfoS src = logGeneric src LevelInfo++-- | Log a warn level message with the given source.+--+-- @since 0.0.0.0+logWarnS+  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)+  => LogSource+  -> DisplayBuilder+  -> m ()+logWarnS src = logGeneric src LevelWarn++-- | Log an error level message with the given source.+--+-- @since 0.0.0.0+logErrorS+  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)+  => LogSource+  -> DisplayBuilder+  -> m ()+logErrorS src = logGeneric src LevelError++-- | Log a message with the specified textual level and the given+-- source.+--+-- @since 0.0.0.0+logOtherS+  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)+  => Text -- ^ level+  -> LogSource+  -> DisplayBuilder+  -> m ()+logOtherS src = logGeneric src . LevelOther++-- | Write a "sticky" line to the terminal. Any subsequent lines will+-- overwrite this one, and that same line will be repeated below+-- again. In other words, the line sticks at the bottom of the output+-- forever. Running this function again will replace the sticky line+-- with a new sticky line. When you want to get rid of the sticky+-- line, run 'logStickyDone'.+--+-- Note that not all 'LogFunc' implementations will support sticky+-- messages as described. However, the 'withLogFunc' implementation+-- provided by this module does.+--+-- @since 0.0.0.0+logSticky :: (MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) => DisplayBuilder -> m ()+logSticky = logOther "sticky"++-- | This will print out the given message with a newline and disable+-- any further stickiness of the line until a new call to 'logSticky'+-- happens.+--+-- @since 0.0.0.0+logStickyDone :: (MonadIO m, HasCallStack, MonadReader env m, HasLogFunc env) => DisplayBuilder -> m ()+logStickyDone = logOther "sticky-done"++-- TODO It might be better at some point to have a 'runSticky' function+-- that encompasses the logSticky->logStickyDone pairing.++canUseUtf8 :: MonadIO m => Handle -> m Bool+canUseUtf8 h = liftIO $ wantWritableHandle "canUseUtf8" h $ \h_ -> do+  -- TODO also handle haOutputNL for CRLF+  return $ (textEncodingName <$> haCodec h_) == Just "UTF-8"++-- | Create a 'LogOptions' value which will store its data in+-- memory. This is primarily intended for testing purposes. This will+-- return both a 'LogOptions' value and an 'IORef' containing the+-- resulting 'Builder' value.+--+-- This will default to non-verbose settings and assume there is a+-- terminal attached. These assumptions can be overridden using the+-- appropriate @set@ functions.+--+-- @since 0.0.0.0+logOptionsMemory :: MonadIO m => m (IORef Builder, LogOptions)+logOptionsMemory = do+  ref <- newIORef mempty+  let options = LogOptions+        { logMinLevel = LevelInfo+        , logVerboseFormat = False+        , logTerminal = True+        , logUseTime = False+        , logUseColor = False+        , logSend = \new -> atomicModifyIORef' ref $ \old -> (old <> new, ())+        }+  return (ref, options)++-- | Create a 'LogOptions' value from the given 'Handle' and whether+-- to perform verbose logging or not. Individiual settings can be+-- overridden using appropriate @set@ functions.+--+-- @since 0.0.0.0+logOptionsHandle+  :: MonadIO m+  => Handle+  -> Bool -- ^ verbose?+  -> m LogOptions+logOptionsHandle handle' verbose = liftIO $ do+  terminal <- hIsTerminalDevice handle'+  useUtf8 <- canUseUtf8 handle'+  unicode <- if useUtf8 then return True else getCanUseUnicode+  return LogOptions+    { logMinLevel = if verbose then LevelDebug else LevelInfo+    , logVerboseFormat = verbose+    , logTerminal = terminal+    , logUseTime = verbose+    , logUseColor = verbose && terminal+    , logSend = \builder ->+        if useUtf8 && unicode+          then hPutBuilder handle' (builder <> flush)+          else do+            let lbs = toLazyByteString builder+                bs = toStrictBytes lbs+            case decodeUtf8' bs of+              Left e -> error $ "mkLogOptions: invalid UTF8 sequence: " ++ show (e, bs)+              Right text -> do+                let text'+                      | unicode = text+                      | otherwise = T.map replaceUnicode text+                TIO.hPutStr handle' text'+                hFlush handle'+    }++-- | Taken from GHC: determine if we should use Unicode syntax+getCanUseUnicode :: IO Bool+getCanUseUnicode = do+    let enc = localeEncoding+        str = "\x2018\x2019"+        test = withCString enc str $ \cstr -> do+            str' <- peekCString enc cstr+            return (str == str')+    test `catchIO` \_ -> return False++-- | Given a 'LogOptions' value, run the given function with the+-- specified 'LogFunc'. A common way to use this function is:+--+-- @+-- let isVerbose = False -- get from the command line instead+-- logOptions' <- logOptionsHandle stderr isVerbose+-- let logOptions = setLogUseTime True logOptions'+-- withLogFunc logOptions $ \lf -> do+--   let app = App -- application specific environment+--         { appLogFunc = lf+--         , appOtherStuff = ...+--         }+--   runRIO app $ do+--     logInfo "Starting app"+--     myApp+-- @+--+-- @since 0.0.0.0+withLogFunc :: MonadUnliftIO m => LogOptions -> (LogFunc -> m a) -> m a+withLogFunc options inner = withRunInIO $ \run -> do+  if logTerminal options+    then bracket+            (newMVar mempty)+            (\var -> do+                state <- takeMVar var+                unless (B.null state) (logSend options "\n"))+            (\var -> run $ inner $ LogFunc $ stickyImpl var options (simpleLogFunc options))+    else+      run $ inner $ LogFunc $ \cs src level str ->+      simpleLogFunc options cs src (noSticky level) str++-- | Replace Unicode characters with non-Unicode equivalents+replaceUnicode :: Char -> Char+replaceUnicode '\x2018' = '`'+replaceUnicode '\x2019' = '\''+replaceUnicode c = c++noSticky :: LogLevel -> LogLevel+noSticky (LevelOther "sticky-done") = LevelInfo+noSticky (LevelOther "sticky") = LevelInfo+noSticky level = level++-- | Configuration for how to create a 'LogFunc'. Intended to be used+-- with the 'withLogFunc' function.+--+-- @since 0.0.0.0+data LogOptions = LogOptions+  { logMinLevel :: !LogLevel+  , logVerboseFormat :: !Bool+  , logTerminal :: !Bool+  , logUseTime :: !Bool+  , logUseColor :: !Bool+  , logSend :: !(Builder -> IO ())+  }++-- | Set the minimum log level. Messages below this level will not be+-- printed.+--+-- Default: in verbose mode, 'LevelDebug'. Otherwise, 'LevelInfo'.+--+-- @since 0.0.0.0+setLogMinLevel :: LogLevel -> LogOptions -> LogOptions+setLogMinLevel level options = options { logMinLevel = level }++-- | Use the verbose format for printing log messages.+--+-- Default: follows the value of the verbose flag.+--+-- @since 0.0.0.0+setLogVerboseFormat :: Bool -> LogOptions -> LogOptions+setLogVerboseFormat v options = options { logVerboseFormat = v }++-- | Do we treat output as a terminal. If @True@, we will enabled+-- sticky logging functionality.+--+-- Default: checks if the @Handle@ provided to 'logOptionsHandle' is a+-- terminal with 'hIsTerminalDevice'.+--+-- @since 0.0.0.0+setLogTerminal :: Bool -> LogOptions -> LogOptions+setLogTerminal t options = options { logTerminal = t }++-- | Include the time when printing log messages.+--+-- Default: true in debug mode, false otherwise.+--+-- @since 0.0.0.0+setLogUseTime :: Bool -> LogOptions -> LogOptions+setLogUseTime t options = options { logUseTime = t }++-- | Use ANSI color codes in the log output.+--+-- Default: true if in verbose mode /and/ the 'Handle' is a terminal device.+--+-- @since 0.0.0.0+setLogUseColor :: Bool -> LogOptions -> LogOptions+setLogUseColor c options = options { logUseColor = c }++simpleLogFunc :: LogOptions -> CallStack -> LogSource -> LogLevel -> DisplayBuilder -> IO ()+simpleLogFunc lo cs _src level msg =+    when (level >= logMinLevel lo) $ do+      timestamp <- getTimestamp+      logSend lo $ getUtf8Builder $+        timestamp <>+        getLevel <>+        ansi reset <>+        msg <>+        getLoc <>+        ansi reset <>+        "\n"+  where+   reset = "\ESC[0m"+   setBlack = "\ESC[90m"+   setGreen = "\ESC[32m"+   setBlue = "\ESC[34m"+   setYellow = "\ESC[33m"+   setRed = "\ESC[31m"+   setMagenta = "\ESC[35m"++   ansi :: DisplayBuilder -> DisplayBuilder+   ansi xs | logUseColor lo = xs+           | otherwise = mempty++   getTimestamp :: IO DisplayBuilder+   getTimestamp+     | logVerboseFormat lo && logUseTime lo =+       do now <- getZonedTime+          return $ ansi setBlack <> fromString (formatTime' now) <> ": "+     | otherwise = return mempty+     where+       formatTime' =+           take timestampLength . formatTime defaultTimeLocale "%F %T.%q"++   getLevel :: DisplayBuilder+   getLevel+     | logVerboseFormat lo =+         case level of+           LevelDebug -> ansi setGreen <> "[debug] "+           LevelInfo -> ansi setBlue <> "[info] "+           LevelWarn -> ansi setYellow <> "[warn] "+           LevelError -> ansi setRed <> "[error] "+           LevelOther name ->+             ansi setMagenta <>+             "[" <>+             display name <>+             "] "+     | otherwise = mempty++   getLoc :: DisplayBuilder+   getLoc+     | logVerboseFormat lo = ansi setBlack <> "\n@(" <> displayCallStack cs <> ")"+     | otherwise = mempty++-- | Convert a 'CallStack' value into a 'DisplayBuilder' indicating+-- the first source location.+--+-- TODO Consider showing the entire call stack instead.+--+-- @since 0.0.0.0+displayCallStack :: CallStack -> DisplayBuilder+displayCallStack cs =+     case reverse $ getCallStack cs of+       [] -> "<no call stack found>"+       (_desc, loc):_ ->+         let file = srcLocFile loc+          in fromString file <>+             ":" <>+             displayShow (srcLocStartLine loc) <>+             ":" <>+             displayShow (srcLocStartCol loc)++-- | The length of a timestamp in the format "YYYY-MM-DD hh:mm:ss.μμμμμμ".+-- This definition is top-level in order to avoid multiple reevaluation at runtime.+timestampLength :: Int+timestampLength =+  length (formatTime defaultTimeLocale "%F %T.000000" (UTCTime (ModifiedJulianDay 0) 0))++stickyImpl+    :: MVar ByteString -> LogOptions+    -> (CallStack -> LogSource -> LogLevel -> DisplayBuilder -> IO ())+    -> CallStack -> LogSource -> LogLevel -> DisplayBuilder -> IO ()+stickyImpl ref lo logFunc loc src level msgOrig = modifyMVar_ ref $ \sticky -> do+  let backSpaceChar = '\8'+      repeating = mconcat . replicate (B.length sticky) . char7+      clear = logSend lo+        (repeating backSpaceChar <>+        repeating ' ' <>+        repeating backSpaceChar)++  case level of+    LevelOther "sticky-done" -> do+      clear+      logFunc loc src LevelInfo msgOrig+      return mempty+    LevelOther "sticky" -> do+      clear+      let bs = toStrictBytes $ toLazyByteString $ getUtf8Builder msgOrig+      logSend lo (byteString bs <> flush)+      return bs+    _+      | level >= logMinLevel lo -> do+          clear+          logFunc loc src level msgOrig+          unless (B.null sticky) $ logSend lo (byteString sticky <> flush)+          return sticky+      | otherwise -> return sticky

@@ -0,0 +1,32 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module RIO.Prelude.RIO+  ( RIO (..)+  , runRIO+  , liftRIO+  ) where++import RIO.Prelude.Reexports++-- | The Reader+IO monad. This is different from a 'ReaderT' because:+--+-- * It's not a transformer, it hardcodes IO for simpler usage and+-- error messages.+--+-- * Instances of typeclasses like 'MonadLogger' are implemented using+-- classes defined on the environment, instead of using an+-- underlying monad.+newtype RIO env a = RIO { unRIO :: ReaderT env IO a }+  deriving (Functor,Applicative,Monad,MonadIO,MonadReader env,MonadThrow)++runRIO :: MonadIO m => env -> RIO env a -> m a+runRIO env (RIO (ReaderT f)) = liftIO (f env)++liftRIO :: (MonadIO m, MonadReader env m) => RIO env a -> m a+liftRIO rio = do+  env <- ask+  runRIO env rio++instance MonadUnliftIO (RIO env) where+    askUnliftIO = RIO $ ReaderT $ \r ->+                  withUnliftIO $ \u ->+                  return (UnliftIO (unliftIO u . flip runReaderT r . unRIO))

@@ -0,0 +1,299 @@+{-# LANGUAGE CPP #-}+module RIO.Prelude.Reexports+  ( module UnliftIO+  -- List imports from UnliftIO?+  , UnliftIO.Concurrent.threadDelay+  , Control.Applicative.Alternative+  , Control.Applicative.Applicative (..)+  , Control.Applicative.liftA+#if !MIN_VERSION_base(4, 10, 0)+  , Control.Applicative.liftA2+#endif+  , Control.Applicative.liftA3+  , Control.Applicative.many+  , Control.Applicative.optional+  , Control.Applicative.some+  , (Control.Applicative.<|>)+  , Control.Arrow.first+  , Control.Arrow.second+  , (Control.Arrow.&&&)+  , (Control.Arrow.***)+  , Control.DeepSeq.NFData(..)+  , Control.DeepSeq.force+  , (Control.DeepSeq.$!!)+  , Control.Monad.Monad(..)+  , Control.Monad.MonadPlus(..)+  , Control.Monad.filterM+  , Control.Monad.foldM+  , Control.Monad.foldM_+  , Control.Monad.forever+  , Control.Monad.guard+  , Control.Monad.join+  , Control.Monad.liftM+  , Control.Monad.liftM2+  , Control.Monad.replicateM_+  , Control.Monad.unless+  , Control.Monad.when+  , Control.Monad.zipWithM+  , Control.Monad.zipWithM_+  , (Control.Monad.<$!>)+  , (Control.Monad.<=<)+  , (Control.Monad.=<<)+  , (Control.Monad.>=>)+  , Control.Monad.Catch.MonadThrow(..)+  , Control.Monad.Reader.MonadReader+  , Control.Monad.Reader.MonadTrans(..)+  , Control.Monad.Reader.ReaderT(..)+  , Control.Monad.Reader.ask+  , Control.Monad.Reader.asks+  , Control.Monad.Reader.local+  , Data.Bool.Bool(..)+  , Data.Bool.not+  , Data.Bool.otherwise+  , (Data.Bool.&&)+  , (Data.Bool.||)+  , Data.ByteString.ByteString+  , Data.ByteString.Builder.Builder+  , Data.ByteString.Short.ShortByteString+  , Data.ByteString.Short.toShort+  , Data.ByteString.Short.fromShort+  , Data.Char.Char+  , Data.Data.Data(..)+  , Data.Either.Either(..)+  , Data.Either.either+  , Data.Either.isLeft+  , Data.Either.isRight+  , Data.Either.lefts+  , Data.Either.partitionEithers+  , Data.Either.rights+  , Data.Eq.Eq(..)+  , Data.Foldable.Foldable+  , Data.Foldable.all+  , Data.Foldable.and+  , Data.Foldable.any+  , Data.Foldable.asum+  , Data.Foldable.concat+  , Data.Foldable.concatMap+  , Data.Foldable.elem+  , Data.Foldable.fold+  , Data.Foldable.foldMap+  , Data.Foldable.foldl'+  , Data.Foldable.foldr+  , Data.Foldable.forM_+  , Data.Foldable.for_+  , Data.Foldable.length+  , Data.Foldable.mapM_+  , Data.Foldable.msum+  , Data.Foldable.notElem+  , Data.Foldable.null+  , Data.Foldable.or+  , Data.Foldable.product+  , Data.Foldable.sequenceA_+  , Data.Foldable.sequence_+  , Data.Foldable.sum+  , Data.Foldable.toList+  , Data.Foldable.traverse_+  , Data.Function.const+  , Data.Function.fix+  , Data.Function.flip+  , Data.Function.id+  , Data.Function.on+  , (Data.Function.$)+  , (Data.Function.&)+  , (Data.Function..)+  , Data.Functor.Functor(..)+  , Data.Functor.void+  , (Data.Functor.$>)+  , (Data.Functor.<$>)+  , Data.Hashable.Hashable+  , Data.HashMap.Strict.HashMap+  , Data.HashSet.HashSet+  , Data.Int.Int+  , Data.Int.Int8+  , Data.Int.Int16+  , Data.Int.Int32+  , Data.Int.Int64+  , Data.IntMap.Strict.IntMap+  , Data.IntSet.IntSet+  , Data.List.break+  , Data.List.drop+  , Data.List.dropWhile+  , Data.List.filter+  , Data.List.lines+  , Data.List.lookup+  , Data.List.map+  , Data.List.replicate+  , Data.List.reverse+  , Data.List.span+  , Data.List.take+  , Data.List.takeWhile+  , Data.List.unlines+  , Data.List.unwords+  , Data.List.words+  , Data.List.zip+  , (Data.List.++)+  , Data.Map.Strict.Map+  , Data.Maybe.Maybe(..)+  , Data.Maybe.catMaybes+  , Data.Maybe.fromMaybe+  , Data.Maybe.isJust+  , Data.Maybe.isNothing+  , Data.Maybe.listToMaybe+  , Data.Maybe.mapMaybe+  , Data.Maybe.maybe+  , Data.Maybe.maybeToList+  , Data.Monoid.All (..)+  , Data.Monoid.Any (..)+  , Data.Monoid.Endo (..)+  , Data.Monoid.First (..)+  , Data.Monoid.Last (..)+  , Data.Monoid.Monoid (..)+  , Data.Monoid.Product (..)+  , Data.Monoid.Sum (..)+  , (Data.Monoid.<>)+  , Data.Ord.Ord(..)+  , Data.Ord.Ordering(..)+  , Data.Ord.comparing+  , Data.Semigroup.Semigroup+  , Data.Set.Set+  , Data.String.IsString(..)+  , Data.Text.Text+  , Data.Text.Encoding.decodeUtf8'+  , Data.Text.Encoding.decodeUtf8With+  , Data.Text.Encoding.encodeUtf8+  , Data.Text.Encoding.encodeUtf8Builder+  , Data.Text.Encoding.Error.UnicodeException(..)+  , Data.Text.Encoding.Error.lenientDecode+  , Data.Traversable.Traversable(..)+  , Data.Traversable.for+  , Data.Traversable.forM+  , Data.Vector.Vector+  , Data.Void.Void+  , Data.Void.absurd+  , Data.Word.Word+  , Data.Word.Word8+  , Data.Word.Word16+  , Data.Word.Word32+  , Data.Word.Word64+  , Data.Word.byteSwap16+  , Data.Word.byteSwap32+  , Data.Word.byteSwap64+  , Foreign.Storable.Storable+  , GHC.Generics.Generic+  , GHC.Stack.HasCallStack+  , Prelude.Bounded (..)+  , Prelude.Double+  , Prelude.Enum+  , Prelude.FilePath+  , Prelude.Float+  , Prelude.Floating (..)+  , Prelude.Fractional (..)+  , Prelude.IO+  , Prelude.Integer+  , Prelude.Integral (..)+  , Prelude.Num (..)+  , Prelude.Rational+  , Prelude.Real (..)+  , Prelude.RealFloat (..)+  , Prelude.RealFrac (..)+  , Prelude.Show+  , Prelude.String+  , Prelude.asTypeOf+  , Prelude.curry+  , Prelude.error+  , Prelude.even+  , Prelude.fromIntegral+  , Prelude.fst+  , Prelude.gcd+  , Prelude.lcm+  , Prelude.odd+  , Prelude.realToFrac+  , Prelude.seq+  , Prelude.show+  , Prelude.snd+  , Prelude.subtract+  , Prelude.uncurry+  , Prelude.undefined+  , (Prelude.$!)+  , (Prelude.^)+  , (Prelude.^^)+  , System.Exit.ExitCode(..)+  , Text.Read.Read+  , Text.Read.readMaybe+    -- * Primitive+  , PrimMonad (..)+    -- * Unbox+  , Unbox+  ) where++import           Control.Applicative      (Applicative)+import           Control.Monad            (Monad (..), liftM, (<=<))+import           Control.Monad.Catch      (MonadThrow)+import           Control.Monad.Primitive  (PrimMonad (..))+import           Control.Monad.Reader     (MonadReader, ReaderT (..), ask, asks)+import           Data.Bool                (otherwise)+import           Data.ByteString          (ByteString)+import           Data.ByteString.Builder  (Builder)+import           Data.Either              (Either (..))+import           Data.Foldable            (foldMap)+import           Data.Function            (flip, ($), (.))+import           Data.Functor             (Functor (..))+import           Data.Int                 (Int)+import           Data.Maybe               (Maybe, catMaybes, fromMaybe)+import           Data.Monoid              (First (..), Monoid (..))+import           Data.Ord                 (Ord)+import           Data.Semigroup           (Semigroup)+import           Data.String              (IsString (..))+import           Data.Text                (Text)+import           Data.Text.Encoding       (decodeUtf8', decodeUtf8With,+                                           encodeUtf8, encodeUtf8Builder)+import           Data.Text.Encoding.Error (UnicodeException, lenientDecode)+import           Data.Traversable         (Traversable (..))+import           Prelude                  (FilePath, IO, Show (..))+import           UnliftIO+import qualified UnliftIO.Concurrent++import           Data.Vector.Unboxed.Mutable (Unbox)+++++-- Reexports+import qualified Control.Applicative+import qualified Control.Arrow+import qualified Control.DeepSeq+import qualified Control.Monad+import qualified Control.Monad.Catch+import qualified Control.Monad.Reader+import qualified Data.Bool+import qualified Data.ByteString.Short+import qualified Data.Char+import qualified Data.Data+import qualified Data.Either+import qualified Data.Eq+import qualified Data.Foldable+import qualified Data.Function+import qualified Data.Functor+import qualified Data.Hashable+import qualified Data.HashMap.Strict+import qualified Data.HashSet+import qualified Data.Int+import qualified Data.IntMap.Strict+import qualified Data.IntSet+import qualified Data.List+import qualified Data.Map.Strict+import qualified Data.Maybe+import qualified Data.Monoid+import qualified Data.Ord+import qualified Data.Set+import qualified Data.Text.Encoding.Error+import qualified Data.Traversable+import qualified Data.Vector+import qualified Data.Void+import qualified Data.Word+import qualified Foreign.Storable+import qualified GHC.Generics+import qualified GHC.Stack+import qualified Prelude+import qualified System.Exit+import qualified Text.Read

@@ -0,0 +1,35 @@+{-# LANGUAGE ConstraintKinds #-}+module RIO.Prelude.Renames+  ( sappend+  , LByteString+  , LText+  , UVector+  , SVector+  , GVector+  , toStrictBytes+  , fromStrictBytes+  ) where++import RIO.Prelude.Reexports+import qualified Data.ByteString.Lazy     as BL+import qualified Data.Vector.Generic      as GVector+import qualified Data.Vector.Storable     as SVector+import qualified Data.Vector.Unboxed      as UVector+import qualified Data.Text.Lazy           as TL+import qualified Data.Semigroup++sappend :: Semigroup s => s -> s -> s+sappend = (Data.Semigroup.<>)++type UVector = UVector.Vector+type SVector = SVector.Vector+type GVector = GVector.Vector++type LByteString = BL.ByteString+type LText = TL.Text++toStrictBytes :: LByteString -> ByteString+toStrictBytes = BL.toStrict++fromStrictBytes :: ByteString -> LByteString+fromStrictBytes = BL.fromStrict

@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}+module RIO.Prelude.Text+  ( stripCR+  , decodeUtf8Lenient+  , tshow+  ) where++import qualified Data.Text                as T+import Data.Text.Encoding (decodeUtf8With)+import RIO.Prelude.Reexports+import Data.Text.Encoding.Error (lenientDecode)++-- | Strip trailing carriage return from Text+stripCR :: Text -> Text+stripCR t = fromMaybe t (T.stripSuffix "\r" t)++tshow :: Show a => a -> Text+tshow = T.pack . show++decodeUtf8Lenient :: ByteString -> Text+decodeUtf8Lenient = decodeUtf8With lenientDecode

@@ -0,0 +1,57 @@+module RIO.Prelude.URef+  ( -- * Unboxed references+    Unbox+  , URef+  , IOURef+  , newURef+  , readURef+  , writeURef+  , modifyURef+  ) where++import RIO.Prelude.Reexports+import qualified Data.Vector.Unboxed.Mutable as MUVector++-- | An unboxed reference. This works like an 'IORef', but the data is+-- stored in a bytearray instead of a heap object, avoiding+-- significant allocation overhead in some cases. For a concrete+-- example, see this Stack Overflow question:+-- <https://stackoverflow.com/questions/27261813/why-is-my-little-stref-int-require-allocating-gigabytes>.+--+-- The first parameter is the state token type, the same as would be+-- used for the 'ST' monad. If you're using an 'IO'-based monad, you+-- can use the convenience 'IOURef' type synonym instead.+--+-- @since 0.0.2.0+newtype URef s a = URef (MUVector.MVector s a)++-- | Helpful type synonym for using a 'URef' from an 'IO'-based stack.+--+-- @since 0.0.2.0+type IOURef = URef (PrimState IO)++-- | Create a new 'URef'+--+-- @since 0.0.2.0+newURef :: (PrimMonad m, Unbox a) => a -> m (URef (PrimState m) a)+newURef a = fmap URef (MUVector.replicate 1 a)++-- | Read the value in a 'URef'+--+-- @since 0.0.2.0+readURef :: (PrimMonad m, Unbox a) => URef (PrimState m) a -> m a+readURef (URef v) = MUVector.unsafeRead v 0++-- | Write a value into a 'URef'. Note that this action is strict, and+-- will force evalution of the value.+--+-- @since 0.0.2.0+writeURef :: (PrimMonad m, Unbox a) => URef (PrimState m) a -> a -> m ()+writeURef (URef v) = MUVector.unsafeWrite v 0++-- | Modify a value in a 'URef'. Note that this action is strict, and+-- will force evaluation of the result value.+--+-- @since 0.0.2.0+modifyURef :: (PrimMonad m, Unbox a) => URef (PrimState m) a -> (a -> a) -> m ()+modifyURef u f = readURef u >>= writeURef u . f

@@ -6,65 +6,203 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} --- | Reading from external processes.-+-- | Interacting with external processes.+--+-- This module provides a layer on top of "System.Process.Typed", with+-- the following additions:+--+-- * For efficiency, it will cache @PATH@ lookups.+--+-- * For convenience, you can set the working directory and env vars+--   overrides in a 'RIO' environment instead of on the individual+--   calls to the process.+--+-- * Built-in support for logging at the debug level.+--+-- In order to switch over to this API, the main idea is:+--+-- * Like most of the rio library, you need to create an environment+--   value (this time 'ProcessContext'), and include it in your 'RIO'+--   environment. See 'mkProcessContext'.+--+-- * Instead of using the 'proc' function for creating a+--   'ProcessConfig', use the 'proc' function, which will handle+--   overriding environment variables, looking up paths, performing+--   logging, etc.+--+-- Once you have your 'ProcessConfig', use the standard functions from+-- 'System.Process.Typed' (reexported here for convenient) for running+-- the 'ProcessConfig'.+--+-- @since 0.0.3.0 module RIO.Process-  (withProcess-  ,withProcess_-  ,EnvOverride(..)-  ,unEnvOverride-  ,mkEnvOverride-  ,modifyEnvOverride-  ,envHelper-  ,doesExecutableExist-  ,findExecutable-  ,getEnvOverride-  ,envSearchPath-  ,preProcess-  ,readProcessNull-  ,ReadProcessException (..)-  ,augmentPath-  ,augmentPathMap-  ,resetExeCache-  ,HasEnvOverride (..)-  ,workingDirL-  ,withProc-  ,withEnvOverride-  ,withModifyEnvOverride-  ,withWorkingDir-  ,runEnvNoLogging-  ,withProcessTimeLog-  ,showProcessArgDebug-  ,exec-  ,execSpawn-  ,execObserve-  ,module System.Process.Typed-  )-  where+  ( -- * Process context+    ProcessContext+  , HasProcessContext (..)+  , EnvVars+  , mkProcessContext+  , mkDefaultProcessContext+  , modifyEnvVars+  , withModifyEnvVars+  , withWorkingDir+    -- ** Lenses+  , workingDirL+  , envVarsL+  , envVarsStringsL+  , exeSearchPathL+    -- ** Actions+  , resetExeCache+    -- * Configuring+  , proc+    -- * Spawning (run child process)+  , withProcess+  , withProcess_+    -- * Exec (replacing current process)+  , exec+  , execSpawn+    -- * Environment helper+  , LoggedProcessContext (..)+  , withProcessContextNoLogging+    -- * Exceptions+  , ProcessException (..)+    -- * Utilities+  , doesExecutableExist+  , findExecutable+  , augmentPath+  , augmentPathMap+  , showProcessArgDebug+    -- * Reexports+  , P.ProcessConfig+  , P.StreamSpec+  , P.StreamType (..)+  , P.Process+  , P.setStdin+  , P.setStdout+  , P.setStderr+  , P.setCloseFds+  , P.setCreateGroup+  , P.setDelegateCtlc+#if MIN_VERSION_process(1, 3, 0)+  , P.setDetachConsole+  , P.setCreateNewConsole+  , P.setNewSession+#endif+#if MIN_VERSION_process(1, 4, 0) && !WINDOWS+  , P.setChildGroup+  , P.setChildUser+#endif+  , P.mkStreamSpec+  , P.inherit+  , P.closed+  , P.byteStringInput+  , P.byteStringOutput+  , P.createPipe+  , P.useHandleOpen+  , P.useHandleClose+  , P.startProcess+  , P.stopProcess+  , P.readProcess+  , P.readProcess_+  , P.runProcess+  , P.runProcess_+  , P.readProcessStdout+  , P.readProcessStdout_+  , P.readProcessStderr+  , P.readProcessStderr_+  , P.waitExitCode+  , P.waitExitCodeSTM+  , P.getExitCode+  , P.getExitCodeSTM+  , P.checkExitCode+  , P.checkExitCodeSTM+  , P.getStdin+  , P.getStdout+  , P.getStderr+  , P.ExitCodeException (..)+  , P.ByteStringOutputException (..)+  , P.unsafeProcessHandle+  ) where -import           RIO.Prelude-import           RIO.Logger+import           RIO import qualified Data.Map as Map import qualified Data.Text as T-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TLE-import           Data.Text.Encoding.Error (lenientDecode)-import           Lens.Micro (set, to) import qualified System.Directory as D import           System.Environment (getEnvironment) import           System.Exit (exitWith) import qualified System.FilePath as FP import qualified System.Process.Typed as P-import           System.Process.Typed hiding (withProcess, withProcess_)+import           System.Process.Typed hiding (withProcess, withProcess_, proc)  #ifndef WINDOWS import           System.Directory (setCurrentDirectory) import           System.Posix.Process (executeFile) #endif -class HasLogFunc env => HasEnvOverride env where-  envOverrideL :: Lens' env EnvOverride+-- | The environment variable map+--+-- @since 0.0.3.0+type EnvVars = Map Text Text +-- | Context in which to run processes.+--+-- @since 0.0.3.0+data ProcessContext = ProcessContext+    { pcTextMap :: !EnvVars+    -- ^ Environment variables as map++    , pcStringList :: ![(String, String)]+    -- ^ Environment variables as association list++    , pcPath :: ![FilePath]+    -- ^ List of directories searched for executables (@PATH@)++    , pcExeCache :: !(IORef (Map FilePath (Either ProcessException FilePath)))+    -- ^ Cache of already looked up executable paths.++    , pcExeExtensions :: [String]+    -- ^ @[""]@ on non-Windows systems, @["", ".exe", ".bat"]@ on Windows++    , pcWorkingDir :: !(Maybe FilePath)+    -- ^ Override the working directory.+    }++-- | Exception type which may be generated in this module.+--+-- /NOTE/ Other exceptions may be thrown by underlying libraries!+--+-- @since 0.0.3.0+data ProcessException+    = NoPathFound+    | ExecutableNotFound String [FilePath]+    | ExecutableNotFoundAt FilePath+    | PathsInvalidInPath [FilePath]+    deriving Typeable+instance Show ProcessException where+    show NoPathFound = "PATH not found in ProcessContext"+    show (ExecutableNotFound name path) = concat+        [ "Executable named "+        , name+        , " not found on path: "+        , show path+        ]+    show (ExecutableNotFoundAt name) =+        "Did not find executable at specified path: " ++ name+    show (PathsInvalidInPath paths) = unlines $+        [ "Would need to add some paths to the PATH environment variable \+          \to continue, but they would be invalid because they contain a "+          ++ show FP.searchPathSeparator ++ "."+        , "Please fix the following paths and try again:"+        ] ++ paths+instance Exception ProcessException++-- | Get the 'ProcessContext' from the environment.+--+-- @since 0.0.3.0+class HasProcessContext env where+  processContextL :: Lens' env ProcessContext+instance HasProcessContext ProcessContext where+  processContextL = id+ data EnvVarFormat = EVFWindows | EVFNotWindows  currentEnvVarFormat :: EnvVarFormat@@ -75,55 +213,58 @@   EVFNotWindows #endif --- | Override the environment received by a child process.-data EnvOverride = EnvOverride-    { eoTextMap :: Map Text Text -- ^ Environment variables as map-    , eoStringList :: [(String, String)] -- ^ Environment variables as association list-    , eoPath :: [FilePath] -- ^ List of directories searched for executables (@PATH@)-    , eoExeCache :: IORef (Map FilePath (Either ReadProcessException FilePath))-    , eoExeExtensions :: [String] -- ^ @[""]@ on non-Windows systems, @["", ".exe", ".bat"]@ on Windows-    , eoWorkingDir :: !(Maybe FilePath)-    }--workingDirL :: HasEnvOverride env => Lens' env (Maybe FilePath)-workingDirL = envOverrideL.lens eoWorkingDir (\x y -> x { eoWorkingDir = y })+-- | Override the working directory processes run in. @Nothing@ means+-- the current process's working directory.+--+-- @since 0.0.3.0+workingDirL :: HasProcessContext env => Lens' env (Maybe FilePath)+workingDirL = processContextL.lens pcWorkingDir (\x y -> x { pcWorkingDir = y }) --- | Get the environment variables from an 'EnvOverride'.-unEnvOverride :: EnvOverride -> Map Text Text-unEnvOverride = eoTextMap+-- | Get the environment variables. We cannot provide a @Lens@ here,+-- since updating the environment variables requires an @IO@ action to+-- allocate a new @IORef@ for holding the executable path cache.+--+-- @since 0.0.3.0+envVarsL :: HasProcessContext env => SimpleGetter env EnvVars+envVarsL = processContextL.to pcTextMap --- | Get the list of directories searched (@PATH@).-envSearchPath :: EnvOverride -> [FilePath]-envSearchPath = eoPath+-- | Get the 'EnvVars' as an associated list of 'String's.+--+-- Useful for interacting with other libraries.+--+-- @since 0.0.3.0+envVarsStringsL :: HasProcessContext env => SimpleGetter env [(String, String)]+envVarsStringsL = processContextL.to pcStringList --- | Modify the environment variables of an 'EnvOverride'.-modifyEnvOverride :: MonadIO m-                  => EnvOverride-                  -> (Map Text Text -> Map Text Text)-                  -> m EnvOverride-modifyEnvOverride eo f = mkEnvOverride (f $ eoTextMap eo)+-- | Get the list of directories searched for executables (the @PATH@).+--+-- Similar to 'envVarMapL', this cannot be a full @Lens@.+--+-- @since 0.0.3.0+exeSearchPathL :: HasProcessContext env => SimpleGetter env [FilePath]+exeSearchPathL = processContextL.to pcPath --- | Create a new 'EnvOverride'.-mkEnvOverride :: MonadIO m-              => Map Text Text-              -> m EnvOverride-mkEnvOverride tm' = do-    ref <- liftIO $ newIORef Map.empty-    return EnvOverride-        { eoTextMap = tm-        , eoStringList = map (T.unpack *** T.unpack) $ Map.toList tm-        , eoPath =+-- | Create a new 'ProcessContext' from the given environment variable map.+--+-- @since 0.0.3.0+mkProcessContext :: MonadIO m => EnvVars -> m ProcessContext+mkProcessContext tm' = do+    ref <- newIORef Map.empty+    return ProcessContext+        { pcTextMap = tm+        , pcStringList = map (T.unpack *** T.unpack) $ Map.toList tm+        , pcPath =              (if isWindows then (".":) else id)              (maybe [] (FP.splitSearchPath . T.unpack) (Map.lookup "PATH" tm))-        , eoExeCache = ref-        , eoExeExtensions =+        , pcExeCache = ref+        , pcExeExtensions =             if isWindows                 then let pathext = fromMaybe                            ".COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE;.WSF;.WSH;.MSC"                            (Map.lookup "PATHEXT" tm)                       in map T.unpack $ "" : T.splitOn ";" pathext                 else [""]-        , eoWorkingDir = Nothing+        , pcWorkingDir = Nothing         }   where     -- Fix case insensitivity of the PATH environment variable on Windows.@@ -138,110 +279,239 @@             EVFWindows -> True             EVFNotWindows -> False --- | Helper conversion function.-envHelper :: EnvOverride -> [(String, String)]-envHelper = eoStringList+-- | Reset the executable cache.+--+-- @since 0.0.3.0+resetExeCache :: (MonadIO m, MonadReader env m, HasProcessContext env) => m ()+resetExeCache = do+  pc <- view processContextL+  atomicModifyIORef (pcExeCache pc) (const mempty) --- | Read from the process, ignoring any output.+-- | Load up an 'EnvOverride' from the standard environment.+mkDefaultProcessContext :: MonadIO m => m ProcessContext+mkDefaultProcessContext =+    liftIO $+    getEnvironment >>=+          mkProcessContext+        . Map.fromList . map (T.pack *** T.pack)++-- | Modify the environment variables of a 'ProcessContext'. ----- Throws a 'ReadProcessException' exception if the process fails.-readProcessNull :: HasEnvOverride env -- FIXME remove-                => String -- ^ Command-                -> [String] -- ^ Command line arguments-                -> RIO env ()-readProcessNull name args =-  -- We want the output to appear in any exceptions, so we capture and drop it-  void $ withProc name args readProcessStdout_+-- This will keep other settings unchanged, in particular the working+-- directory.+--+-- Note that this requires 'MonadIO', as it will create a new 'IORef'+-- for the cache.+--+-- @since 0.0.3.0+modifyEnvVars+  :: MonadIO m+  => ProcessContext+  -> (EnvVars -> EnvVars)+  -> m ProcessContext+modifyEnvVars pc f = do+  pc' <- mkProcessContext (f $ pcTextMap pc)+  return pc' { pcWorkingDir = pcWorkingDir pc } --- | An exception while trying to read from process.-data ReadProcessException-    = NoPathFound-    | ExecutableNotFound String [FilePath]-    | ExecutableNotFoundAt FilePath-    deriving Typeable-instance Show ReadProcessException where-    show NoPathFound = "PATH not found in EnvOverride"-    show (ExecutableNotFound name path) = concat-        [ "Executable named "-        , name-        , " not found on path: "-        , show path-        ]-    show (ExecutableNotFoundAt name) =-        "Did not find executable at specified path: " ++ name-instance Exception ReadProcessException+-- | Use 'modifyEnvVarMap' to create a new 'ProcessContext', and then+-- use it in the provided action.+--+-- @since 0.0.3.0+withModifyEnvVars+  :: (HasProcessContext env, MonadReader env m, MonadIO m)+  => (EnvVars -> EnvVars)+  -> m a+  -> m a+withModifyEnvVars f inner = do+  pc <- view processContextL+  pc' <- modifyEnvVars pc f+  local (set processContextL pc') inner --- | Provide a 'ProcessConfig' based on the 'EnvOverride' in+-- | Set the working directory to be used by child processes.+--+-- @since 0.0.3.0+withWorkingDir+  :: (HasProcessContext env, MonadReader env m, MonadIO m)+  => FilePath+  -> m a+  -> m a+withWorkingDir = local . set workingDirL . Just++-- | Perform pre-call-process tasks.  Ensure the working directory exists and find the+-- executable path.+--+-- Throws a 'ProcessException' if unsuccessful.+--+-- NOT CURRENTLY EXPORTED+preProcess+  :: (HasProcessContext env, MonadReader env m, MonadIO m)+  => String            -- ^ Command name+  -> m FilePath+preProcess name = do+  name' <- findExecutable name >>= either throwIO return+  wd <- view workingDirL+  liftIO $ maybe (return ()) (D.createDirectoryIfMissing True) wd+  return name'++-- | Log running a process with its arguments, for debugging (-v).+--+-- This logs one message before running the process and one message after.+--+-- NOT CURRENTLY EXPORTED+withProcessTimeLog+  :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack)+  => Maybe FilePath -- ^ working dirj+  -> String -- ^ executable+  -> [String] -- ^ arguments+  -> m a+  -> m a+withProcessTimeLog mdir name args proc' = do+  let cmdText =+          T.intercalate+              " "+              (T.pack name : map showProcessArgDebug args)+      dirMsg =+        case mdir of+          Nothing -> ""+          Just dir -> " within " <> T.pack dir+  logDebug ("Run process" <> display dirMsg <> ": " <> display cmdText)+  start <- getMonotonicTime+  x <- proc'+  end <- getMonotonicTime+  let diff = end - start+  -- useAnsi <- asks getAnsiTerminal FIXME+  let useAnsi = True+  logDebug+      ("Process finished in " <>+      (if useAnsi then "\ESC[92m" else "") <> -- green+      timeSpecMilliSecondText diff <>+      (if useAnsi then "\ESC[0m" else "") <> -- reset+       ": " <> display cmdText)+  return x++timeSpecMilliSecondText :: Double -> DisplayBuilder+timeSpecMilliSecondText d = display (round (d * 1000) :: Int) <> "ms"++-- | Provide a 'ProcessConfig' based on the 'ProcessContext' in -- scope. Deals with resolving the full path, setting the child -- process's environment variables, setting the working directory, and -- wrapping the call with 'withProcessTimeLog' for debugging output.-withProc-  :: HasEnvOverride env+--+-- This is intended to be analogous to the @proc@ function provided by+-- the @System.Process.Typed@ module, but has a different type+-- signature to (1) allow it to perform @IO@ actions for looking up+-- paths, and (2) allow logging and timing of the running action.+--+-- @since 0.0.3.0+proc+  :: (HasProcessContext env, HasLogFunc env, MonadReader env m, MonadIO m, HasCallStack)   => FilePath -- ^ command to run   -> [String] -- ^ command line arguments-  -> (ProcessConfig () () () -> RIO env a)-  -> RIO env a-withProc name0 args inner = do-  menv <- view envOverrideL+  -> (ProcessConfig () () () -> m a)+  -> m a+proc name0 args inner = do   name <- preProcess name0+  wd <- view workingDirL+  envStrings <- view envVarsStringsL -  withProcessTimeLog (eoWorkingDir menv) name args+  withProcessTimeLog wd name args     $ inner-    $ setEnv (envHelper menv)-    $ maybe id setWorkingDir (eoWorkingDir menv)-    $ proc name args+    $ setEnv envStrings+    $ maybe id setWorkingDir wd+    $ P.proc name args --- | Apply the given function to the modified environment--- variables. For more details, see 'withEnvOverride'.-withModifyEnvOverride :: HasEnvOverride env => (Map Text Text -> Map Text Text) -> RIO env a -> RIO env a-withModifyEnvOverride f inner = do-  menv <- view envOverrideL-  menv' <- modifyEnvOverride menv f-  withEnvOverride menv' inner+-- | Same as 'P.withProcess', but generalized to 'MonadUnliftIO'.+--+-- @since 0.0.3.0+withProcess+  :: MonadUnliftIO m+  => ProcessConfig stdin stdout stderr+  -> (Process stdin stdout stderr -> m a)+  -> m a+withProcess pc f = withRunInIO $ \run -> P.withProcess pc (run . f) --- | Set a new 'EnvOverride' in the child reader. Note that this will--- keep the working directory set in the parent with 'withWorkingDir'.-withEnvOverride :: HasEnvOverride env => EnvOverride -> RIO env a -> RIO env a-withEnvOverride newEnv = local $ \r ->-  let newEnv' = newEnv { eoWorkingDir = eoWorkingDir $ view envOverrideL r }-   in set envOverrideL newEnv' r+-- | Same as 'P.withProcess_', but generalized to 'MonadUnliftIO'.+--+-- @since 0.0.3.0+withProcess_+  :: MonadUnliftIO m+  => ProcessConfig stdin stdout stderr+  -> (Process stdin stdout stderr -> m a)+  -> m a+withProcess_ pc f = withRunInIO $ \run -> P.withProcess_ pc (run . f) --- | Set the working directory to be used by child processes.-withWorkingDir :: HasEnvOverride env => FilePath -> RIO env a -> RIO env a-withWorkingDir = local . set workingDirL . Just+-- | A convenience environment combining a 'LogFunc' and a 'ProcessContext'+--+-- @since 0.0.3.0+data LoggedProcessContext = LoggedProcessContext ProcessContext LogFunc --- | Perform pre-call-process tasks.  Ensure the working directory exists and find the--- executable path.+instance HasLogFunc LoggedProcessContext where+  logFuncL = lens (\(LoggedProcessContext _ lf) -> lf) (\(LoggedProcessContext pc _) lf -> LoggedProcessContext pc lf)+instance HasProcessContext LoggedProcessContext where+  processContextL = lens (\(LoggedProcessContext x _) -> x) (\(LoggedProcessContext _ lf) pc -> LoggedProcessContext pc lf)++-- | Run an action using a 'LoggedProcessContext' with default+-- settings and no logging. ----- Throws a 'ReadProcessException' if unsuccessful.-preProcess-  :: HasEnvOverride env-  => String            -- ^ Command name-  -> RIO env  FilePath-preProcess name = do-  menv <- view envOverrideL-  let wd = eoWorkingDir menv-  name' <- liftIO $ join $ findExecutable menv name-  liftIO $ maybe (return ()) (D.createDirectoryIfMissing True) wd-  return name'+-- @since 0.0.3.0+withProcessContextNoLogging :: MonadIO m => RIO LoggedProcessContext a -> m a+withProcessContextNoLogging inner = do+  pc <- mkDefaultProcessContext+  runRIO (LoggedProcessContext pc mempty) inner +-- | Execute a process within the configured environment.+--+-- Execution will not return, because either:+--+-- 1) On non-windows, execution is taken over by execv of the+-- sub-process. This allows signals to be propagated (#527)+--+-- 2) On windows, an 'ExitCode' exception will be thrown.+--+-- @since 0.0.3.0+exec :: (HasProcessContext env, HasLogFunc env) => String -> [String] -> RIO env b+#ifdef WINDOWS+exec = execSpawn+#else+exec cmd0 args = do+    wd <- view workingDirL+    envStringsL <- view envVarsStringsL+    cmd <- preProcess cmd0+    withProcessTimeLog wd cmd args $ liftIO $ do+      for_ wd setCurrentDirectory+      executeFile cmd True args $ Just envStringsL+#endif++-- | Like 'exec', but does not use 'execv' on non-windows. This way,+-- there is a sub-process, which is helpful in some cases+-- (<https://github.com/commercialhaskell/stack/issues/1306>).+--+-- This function only exits by throwing 'ExitCode'.+--+-- @since 0.0.3.0+execSpawn :: (HasProcessContext env, HasLogFunc env) => String -> [String] -> RIO env a+execSpawn cmd args = proc cmd args (runProcess . setStdin inherit) >>= liftIO . exitWith+ -- | Check if the given executable exists on the given PATH.-doesExecutableExist :: (MonadIO m)-  => EnvOverride       -- ^ How to override environment-  -> String            -- ^ Name of executable+--+-- @since 0.0.3.0+doesExecutableExist+  :: (MonadIO m, MonadReader env m, HasProcessContext env)+  => String            -- ^ Name of executable   -> m Bool-doesExecutableExist menv name = liftM isJust $ findExecutable menv name+doesExecutableExist = liftM isRight . findExecutable  -- | Find the complete path for the executable. ----- Throws a 'ReadProcessException' if unsuccessful.-findExecutable :: (MonadIO m, MonadThrow n)-  => EnvOverride       -- ^ How to override environment-  -> String            -- ^ Name of executable-  -> m (n FilePath) -- ^ Full path to that executable on success-findExecutable eo name0 | any FP.isPathSeparator name0 = do-    let names0 = map (name0 ++) (eoExeExtensions eo)-        testNames [] = return $ throwM $ ExecutableNotFoundAt name0+-- @since 0.0.3.0+findExecutable+  :: (MonadIO m, MonadReader env m, HasProcessContext env)+  => String            -- ^ Name of executable+  -> m (Either ProcessException FilePath) -- ^ Full path to that executable on success+findExecutable name0 | any FP.isPathSeparator name0 = do+    pc <- view processContextL+    let names0 = map (name0 ++) (pcExeExtensions pc)+        testNames [] = return $ Left $ ExecutableNotFoundAt name0         testNames (name:names) = do             exists <- liftIO $ D.doesFileExist name             if exists@@ -250,15 +520,16 @@                     return $ return path                 else testNames names     testNames names0-findExecutable eo name = liftIO $ do-    m <- readIORef $ eoExeCache eo+findExecutable name = do+    pc <- view processContextL+    m <- readIORef $ pcExeCache pc     epath <- case Map.lookup name m of         Just epath -> return epath         Nothing -> do-            let loop [] = return $ Left $ ExecutableNotFound name (eoPath eo)+            let loop [] = return $ Left $ ExecutableNotFound name (pcPath pc)                 loop (dir:dirs) = do                     let fp0 = dir FP.</> name-                        fps0 = map (fp0 ++) (eoExeExtensions eo)+                        fps0 = map (fp0 ++) (pcExeExtensions pc)                         testFPs [] = loop dirs                         testFPs (fp:fps) = do                             exists <- D.doesFileExist fp@@ -269,97 +540,38 @@                                     return $ return fp'                                 else testFPs fps                     testFPs fps0-            epath <- loop $ eoPath eo-            () <- atomicModifyIORef (eoExeCache eo) $ \m' ->+            epath <- liftIO $ loop $ pcPath pc+            () <- atomicModifyIORef (pcExeCache pc) $ \m' ->                 (Map.insert name epath m', ())             return epath-    return $ either throwM return epath---- | Reset the executable cache.-resetExeCache :: MonadIO m => EnvOverride -> m ()-resetExeCache eo = liftIO (atomicModifyIORef (eoExeCache eo) (const mempty))---- | Load up an 'EnvOverride' from the standard environment.-getEnvOverride :: MonadIO m => m EnvOverride-getEnvOverride =-    liftIO $-    getEnvironment >>=-          mkEnvOverride-        . Map.fromList . map (T.pack *** T.pack)--newtype InvalidPathException = PathsInvalidInPath [FilePath]-    deriving Typeable--instance Exception InvalidPathException-instance Show InvalidPathException where-    show (PathsInvalidInPath paths) = unlines $-        [ "Would need to add some paths to the PATH environment variable \-          \to continue, but they would be invalid because they contain a "-          ++ show FP.searchPathSeparator ++ "."-        , "Please fix the following paths and try again:"-        ] ++ paths+    return epath  -- | Augment the PATH environment variable with the given extra paths.-augmentPath :: MonadThrow m => [FilePath] -> Maybe Text -> m Text+--+-- @since 0.0.3.0+augmentPath :: [FilePath] -> Maybe Text -> Either ProcessException Text augmentPath dirs mpath =-  do let illegal = filter (FP.searchPathSeparator `elem`) dirs-     unless (null illegal) (throwM $ PathsInvalidInPath illegal)-     return $ T.intercalate (T.singleton FP.searchPathSeparator)+  case filter (FP.searchPathSeparator `elem`) dirs of+    [] -> Right+            $ T.intercalate (T.singleton FP.searchPathSeparator)             $ map (T.pack . FP.dropTrailingPathSeparator) dirs             ++ maybeToList mpath+    illegal -> Left $ PathsInvalidInPath illegal --- | Apply 'augmentPath' on the PATH value in the given Map.-augmentPathMap :: MonadThrow m => [FilePath] -> Map Text Text -> m (Map Text Text)+-- | Apply 'augmentPath' on the PATH value in the given 'EnvVars'.+--+-- @since 0.0.3.0+augmentPathMap :: [FilePath] -> EnvVars -> Either ProcessException EnvVars augmentPathMap dirs origEnv =   do path <- augmentPath dirs mpath      return $ Map.insert "PATH" path origEnv   where     mpath = Map.lookup "PATH" origEnv -runEnvNoLogging :: RIO EnvNoLogging a -> IO a-runEnvNoLogging inner = do-  menv <- getEnvOverride-  runRIO (EnvNoLogging menv) inner--newtype EnvNoLogging = EnvNoLogging EnvOverride-instance HasLogFunc EnvNoLogging where-  logFuncL = to (\_ _ _ _ _ -> return ())-instance HasEnvOverride EnvNoLogging where-  envOverrideL = lens (\(EnvNoLogging x) -> x) (const EnvNoLogging)---- | Log running a process with its arguments, for debugging (-v).------ This logs one message before running the process and one message after.-withProcessTimeLog :: (MonadIO m, MonadReader env m, HasLogFunc env, HasCallStack) => Maybe FilePath -> String -> [String] -> m a -> m a-withProcessTimeLog mdir name args proc' = do-  let cmdText =-          T.intercalate-              " "-              (T.pack name : map showProcessArgDebug args)-      dirMsg =-        case mdir of-          Nothing -> ""-          Just dir -> " within " <> T.pack dir-  logDebug ("Run process" <> display dirMsg <> ": " <> display cmdText)-  start <- getMonotonicTime-  x <- proc'-  end <- getMonotonicTime-  let diff = end - start-  -- useAnsi <- asks getAnsiTerminal FIXME-  let useAnsi = True-  logDebug-      ("Process finished in " <>-      (if useAnsi then "\ESC[92m" else "") <> -- green-      timeSpecMilliSecondText diff <>-      (if useAnsi then "\ESC[0m" else "") <> -- reset-       ": " <> display cmdText)-  return x--timeSpecMilliSecondText :: Double -> DisplayBuilder-timeSpecMilliSecondText d = display (round (d * 1000) :: Int) <> "ms"- -- | Show a process arg including speechmarks when necessary. Just for -- debugging purposes, not functionally important.+--+-- @since 0.0.3.0 showProcessArgDebug :: String -> Text showProcessArgDebug x     | any special x || null x = T.pack (show x)@@ -367,58 +579,3 @@   where special '"' = True         special ' ' = True         special _ = False---- | Execute a process within the Stack configured environment.------ Execution will not return, because either:------ 1) On non-windows, execution is taken over by execv of the--- sub-process. This allows signals to be propagated (#527)------ 2) On windows, an 'ExitCode' exception will be thrown.-exec :: HasEnvOverride env => String -> [String] -> RIO env b-#ifdef WINDOWS-exec = execSpawn-#else-exec cmd0 args = do-    menv <- view envOverrideL-    cmd <- preProcess cmd0-    withProcessTimeLog Nothing cmd args $ liftIO $ do-      for_ (eoWorkingDir menv) setCurrentDirectory-      executeFile cmd True args $ Just $ envHelper menv-#endif---- | Like 'exec', but does not use 'execv' on non-windows. This way, there--- is a sub-process, which is helpful in some cases (#1306)------ This function only exits by throwing 'ExitCode'.-execSpawn :: HasEnvOverride env => String -> [String] -> RIO env a-execSpawn cmd args = withProc cmd args (runProcess . setStdin inherit) >>= liftIO . exitWith--execObserve :: HasEnvOverride env => String -> [String] -> RIO env String-execObserve cmd0 args =-  withProc cmd0 args $ \pc -> do-    (out, _err) <- readProcess_ pc-    return-      $ TL.unpack-      $ TL.filter (/= '\r')-      $ TL.concat-      $ take 1-      $ TL.lines-      $ TLE.decodeUtf8With lenientDecode out---- | Same as 'P.withProcess', but generalized to 'MonadUnliftIO'.-withProcess-  :: MonadUnliftIO m-  => ProcessConfig stdin stdout stderr-  -> (Process stdin stdout stderr -> m a)-  -> m a-withProcess pc f = withRunInIO $ \run -> P.withProcess pc (run . f)---- | Same as 'P.withProcess_', but generalized to 'MonadUnliftIO'.-withProcess_-  :: MonadUnliftIO m-  => ProcessConfig stdin stdout stderr-  -> (Process stdin stdout stderr -> m a)-  -> m a-withProcess_ pc f = withRunInIO $ \run -> P.withProcess_ pc (run . f)

@@ -7,8 +7,27 @@   , Data.Text.Encoding.decodeUtf8With   , Data.Text.Encoding.decodeUtf8'   , Data.Text.Encoding.Error.lenientDecode+  , dropPrefix+  , dropSuffix   ) where  import           Data.Text -- FIXME hide partials import qualified Data.Text.Encoding import qualified Data.Text.Encoding.Error+import           Data.Maybe (fromMaybe)++-- | Drop prefix if present, otherwise return original 'Text'.+--+-- @since 0.0.0.0+dropPrefix :: Text -- ^ prefix+           -> Text+           -> Text+dropPrefix prefix t = fromMaybe t (stripPrefix prefix t)++-- | Drop prefix if present, otherwise return original 'Text'.+--+-- @since 0.0.0.0+dropSuffix :: Text -- ^ suffix+           -> Text+           -> Text+dropSuffix suffix t = fromMaybe t (stripSuffix suffix t)

@@ -0,0 +1,15 @@+{-# LANGUAGE NoImplicitPrelude #-}+module RIO.ListSpec where++import Test.Hspec+import RIO+import qualified RIO.List as List++spec :: Spec+spec = do+  describe "dropPrefix" $ do+    it "present" $ List.dropPrefix "foo" "foobar" `shouldBe` "bar"+    it "absent" $ List.dropPrefix "bar" "foobar" `shouldBe` "foobar"+  describe "dropSuffix" $ do+    it "present" $ List.dropSuffix "bar" "foobar" `shouldBe` "foo"+    it "absent" $ List.dropSuffix "foo" "foobar" `shouldBe` "foobar"

@@ -9,31 +9,15 @@ spec :: Spec spec = do   it "sanity" $ do-    ref <- newIORef mempty-    let options = LogOptions-          { logMinLevel = LevelInfo-          , logVerboseFormat = False-          , logTerminal = True-          , logUseTime = False-          , logUseColor = False-          , logSend = \builder -> modifyIORef ref (<> builder)-          }-    withStickyLogger options $ \lf -> runRIO lf $ do+    (ref, options) <- logOptionsMemory+    withLogFunc options $ \lf -> runRIO lf $ do       logDebug "should not appear"       logInfo "should appear"     builder <- readIORef ref     toLazyByteString builder `shouldBe` "should appear\n"   it "sticky" $ do-    ref <- newIORef mempty-    let options = LogOptions-          { logMinLevel = LevelInfo-          , logVerboseFormat = False-          , logTerminal = True-          , logUseTime = False-          , logUseColor = False-          , logSend = \builder -> modifyIORef ref (<> builder)-          }-    withStickyLogger options $ \lf -> runRIO lf $ do+    (ref, options) <- logOptionsMemory+    withLogFunc options $ \lf -> runRIO lf $ do       logSticky "ABC"       logDebug "should not appear"       logInfo "should appear"

@@ -4,7 +4,6 @@  import Test.Hspec import RIO-import Data.ByteString.Builder (toLazyByteString)  spec :: Spec spec = do

@@ -0,0 +1,16 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+module RIO.TextSpec where++import Test.Hspec+import RIO+import qualified RIO.Text as T++spec :: Spec+spec = do+  describe "dropPrefix" $ do+    it "present" $ T.dropPrefix "foo" "foobar" `shouldBe` "bar"+    it "absent" $ T.dropPrefix "bar" "foobar" `shouldBe` "foobar"+  describe "dropSuffix" $ do+    it "present" $ T.dropSuffix "bar" "foobar" `shouldBe` "foo"+    it "absent" $ T.dropSuffix "foo" "foobar" `shouldBe` "foobar"