safe-coloured-text-terminfo (empty) → 0.0.0.0

raw patch · 4 files changed

+122/−0 lines, 4 filesdep +basedep +safe-coloured-textdep +terminfo

Dependencies added: base, safe-coloured-text, terminfo

Files

• LICENSE +21/−0
• safe-coloured-text-terminfo.cabal +36/−0
• src/Text/Colour/Capabilities/FromEnv.hs +44/−0
• src/Text/Colour/Term.hs +21/−0

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2021 Tom Sydney Kerckhove++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,36 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           safe-coloured-text-terminfo+version:        0.0.0.0+synopsis:       Safely output coloured text+category:       User Interfaces+homepage:       https://github.com/NorfairKing/safe-coloured-text#readme+bug-reports:    https://github.com/NorfairKing/safe-coloured-text/issues+author:         Tom Sydney Kerckhove+maintainer:     syd@cs-syd.eu+copyright:      Copyright (c) 2020 Tom Sydney Kerckhove+license:        MIT+license-file:   LICENSE+build-type:     Simple++source-repository head+  type: git+  location: https://github.com/NorfairKing/safe-coloured-text++library+  exposed-modules:+      Text.Colour.Capabilities.FromEnv+      Text.Colour.Term+  other-modules:+      Paths_safe_coloured_text_terminfo+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , safe-coloured-text+    , terminfo+  default-language: Haskell2010

@@ -0,0 +1,44 @@+{-# LANGUAGE ScopedTypeVariables #-}++module Text.Colour.Capabilities.FromEnv where++import Control.Exception+import qualified System.Console.Terminfo as Terminfo+import System.Environment (lookupEnv)+import System.IO+import Text.Colour.Capabilities++-- | Try to detect how many colours the terminal can handle.+--+-- This is based on the @colors@ capability of the terminfo detected based on the @TERM@ environment variable.+-- If the terminal can handle 8-bit colours and also has the @COLORTERM@ environment variable set to @24bit@ or @truecolor@, then this function will return 'With24BitColours'.+getTerminalCapabilitiesFromEnv :: IO TerminalCapabilities+getTerminalCapabilitiesFromEnv = do+  mTerm <- (Just <$> Terminfo.setupTermFromEnv) `catch` (\(_ :: Terminfo.SetupTermError) -> pure Nothing)+  case mTerm of+    Nothing -> pure WithoutColours+    Just term -> do+      -- To support 24-bit colour:+      -- https://unix.stackexchange.com/questions/450365/check-if-terminal-supports-24-bit-true-color+      mct <- lookupEnv "COLORTERM"+      pure $ case mct of+        Just "truecolor" -> With24BitColours+        Just "24bit" -> With24BitColours+        _ ->+          case Terminfo.getCapability term (Terminfo.tiGetNum "colors") of+            Nothing -> WithoutColours+            Just c+              | c > 256 -> With24BitColours+              | c >= 256 -> With8BitColours+              | c >= 8 -> With8Colours+              | otherwise -> WithoutColours++-- | Try to detect how many colours a given handle can handle.+--+-- This function does the same as 'getTerminalCapabilitiesFromEnv' but returns 'WithoutColours' is not a terminal device.+getTerminalCapabilitiesFromHandle :: Handle -> IO TerminalCapabilities+getTerminalCapabilitiesFromHandle h = do+  isTerm <- hIsTerminalDevice h+  if isTerm+    then getTerminalCapabilitiesFromEnv+    else pure WithoutColours

@@ -0,0 +1,21 @@+module Text.Colour.Term where++import System.IO+import Text.Colour+import Text.Colour.Capabilities.FromEnv++-- | Print a list of chunks to 'stdout'.+--+-- This function will use 'getTerminalCapabilitiesHandle' on 'stdout'.+-- If you intend to use this function more than once, it is more efficient to use 'getTerminalCapabilitiesFromEnv' first and then use 'putChunksWith'.+putChunks :: [Chunk] -> IO ()+putChunks = hPutChunks stdout++-- | Print a list of chunks to the given 'Handle'+--+-- This function will use 'getTerminalCapabilitiesHandle' on the given handle.+-- If you intend to use this function more than once, it is more efficient to use 'getTerminalCapabilitiesHandle' first and then use 'hPutChunksWith'.+hPutChunks :: Handle -> [Chunk] -> IO ()+hPutChunks h cs = do+  tc <- getTerminalCapabilitiesFromHandle h+  hPutChunksWith tc h cs