di-handle (empty) → 1.0

raw patch · 6 files changed

+178/−0 lines, 6 filesdep +basedep +bytestringdep +di-coresetup-changed

Dependencies added: base, bytestring, di-core, exceptions, unix

Files

CHANGELOG.md +7/−0
LICENSE.txt +30/−0
README.md +10/−0
Setup.hs +4/−0
di-handle.cabal +30/−0
lib/Di/Handle.hs +97/−0

+ CHANGELOG.md view

@@ -0,0 +1,7 @@+# Version 1.0++* This library contains some of what was in `di-0.3`, conceptually at least.+  Consider this first release of the new ecosystem a preview release: The API is+  likely to stay stable, but extensive testing, formalization and tooling is+  due.+

+ LICENSE.txt view

@@ -0,0 +1,30 @@+Copyright (c) 2017-2018, Renzo Carbonara++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Renzo Carbonara nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,10 @@+# di-handle++Support for rendering to `Handle`s (e.g., files, stderr, stdout) with+[di-core](https://hackage.haskell.org/package/di-core).++[![Build Status](https://travis-ci.org/k0001/di.svg?branch=master)](https://travis-ci.org/k0001/di)++See the [BSD3 LICENSE](https://github.com/k0001/di/blob/master/di-handle/LICENSE.txt)+file to learn about the legal terms and conditions for this library.+

+ Setup.hs view

@@ -0,0 +1,4 @@+#! /usr/bin/env nix-shell+#! nix-shell ./shell.nix -i runghc+import Distribution.Simple+main = defaultMain

+ di-handle.cabal view

@@ -0,0 +1,30 @@+name: di-handle+version: 1.0+author: Renzo Carbonara+maintainer: renλren.zone+copyright: Renzo Carbonara 2017-2018+license: BSD3+license-file: LICENSE.txt+extra-source-files: README.md CHANGELOG.md+category: Logging+build-type: Simple+cabal-version: >=1.18+synopsis: IO support for file handles in di-core+description: IO support for file handles in di-core+homepage: https://github.com/k0001/di+bug-reports: https://github.com/k0001/di/issues++library+  hs-source-dirs: lib+  default-language: Haskell2010+  exposed-modules: Di.Handle+  build-depends:+    base >=4.9 && <5.0,+    bytestring,+    exceptions,+    di-core+  ghcjs-options: -Wall -O3+  ghc-options: -Wall -O2+  if !os(windows)+     build-depends: unix+

+ lib/Di/Handle.hs view

@@ -0,0 +1,97 @@+{-# LANGUAGE CPP #-}++module Di.Handle+ ( stderr+ , handle+ , blob+ , LineRenderer(LineRendererUtf8)+ , BlobRenderer(BlobRenderer)+ ) where++import qualified Control.Monad.Catch as Ex+import Control.Monad.IO.Class (MonadIO(liftIO))+import qualified Data.ByteString.Builder as BB+import Data.Monoid ((<>))+import qualified System.IO as IO++#ifdef VERSION_unix+import qualified System.Posix.Terminal+import qualified System.Posix.IO+#endif++import Di.Core (Log)++--------------------------------------------------------------------------------++-- | How to render a 'Log' as a line of text.+data LineRenderer level path msg+  = LineRendererUtf8 !(Bool -> Log level path msg -> BB.Builder)+  -- ^ The returned bytes must not contain a leading nor trailing newline.+  --+  -- The 'Bool' tells whether we are trying to write these bytes to a+  -- terminal that supports ANSI colors.++-- | How to render a 'Log' as a binary blob.+data BlobRenderer level path msg+  = BlobRenderer !(Log level path msg -> BB.Builder)++--------------------------------------------------------------------------------++-- | Like 'blob', but each 'Log' is rendered as text in its own line.+--+-- If the given 'IO.Handle' is associated to a TTY supporting ANSI colors, and+-- the given 'LineRenderer' supports rendering with colors, and you ask for+-- it, then you will get colorful output.+handle+  :: (MonadIO m, MonadIO n)+  => Maybe Bool+  -- ^ Whether to render with colors.+  --+  -- If 'Nothing', then we'll render with ANSI colors when the given+  -- 'IO.Handle' is a TTY. You probably want to use 'Nothing' here most of the+  -- time.+  -> IO.Handle  -- ^ Handle where to write 'Log's.+  -> LineRenderer level path msg -- ^ How to render each 'Log'.+  -> m (Log level path msg -> n ())+handle ywantColors h (LineRendererUtf8 render0) = liftIO $ do+  wantColors <- maybe (isTty h) pure ywantColors+  let !render1 = render0 wantColors+      !newline = BB.char7 '\n'+      render2 = \log' -> render1 log' <> newline+  blob h (BlobRenderer render2)++-- | Write 'Log's to a 'IO.Handle' as a binary blob.+blob+  :: (MonadIO m, MonadIO n)+  => IO.Handle -- ^ Handle where to write 'Log's.+  -> BlobRenderer level path msg -- ^ How to render each 'Log'.+  -> m (Log level path msg -> n ())+blob h (BlobRenderer render) = liftIO $ do+  IO.hSetBinaryMode h True+  pure $ \log_ ->+     liftIO (Ex.finally (BB.hPutBuilder h (render log_))+                        (IO.hFlush h))++-- | 'Log's are written to 'IO.stderr', one per line.+--+-- /WARNING/ Currently this always renders as UTF-8.+stderr+  :: (MonadIO m, MonadIO n)+  => LineRenderer level path msg -- ^ How to render each 'Log' line.+  -> m (Log level path msg -> n ())+stderr = handle Nothing IO.stderr++--------------------------------------------------------------------------------++isTty :: IO.Handle -> IO Bool+#ifdef VERSION_unix+isTty h+  | h == IO.stderr = q System.Posix.IO.stdError+  | h == IO.stdout = q System.Posix.IO.stdOutput+  | h == IO.stdin  = q System.Posix.IO.stdInput+  | otherwise = pure False  -- Is this good enough?+  where q = System.Posix.Terminal.queryTerminal+#else+isTty _ = pure False+#endif+