Skip to content

Commit 172f10e

Browse files
psibipsibi
authored
Merge pull request #40 from MorrowM/no-color
Allow disabling colors (#29)
2 parents 0e1b6bd + 81f08d5 commit 172f10e

8 files changed

Lines changed: 75 additions & 33 deletions

File tree

‎CHANGELOG.md‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,8 @@
1+
# 0.9.1
2+
3+
* When the [`NO_COLOR`](https://no-color.org/) environment variable is set, the client will not color the output.
4+
* Added `--[no-]color` options which enable/disable output coloring (overrides `NO_COLOR`).
5+
16
# 0.9.0
27

38
* When pages are updated, the client now shows the download location.

‎package.yaml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
name: tldr
2-
version: '0.9.0'
2+
version: '0.9.1'
33
synopsis: Haskell tldr client
44
description: |
55
Haskell tldr client with support for viewing tldr pages. Has offline

‎src/Tldr.hs‎

Lines changed: 29 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ import Data.Monoid ((<>))
1616
import Data.Text hiding (cons)
1717
import GHC.IO.Handle (Handle)
1818
import System.Console.ANSI
19-
import Tldr.Types (ConsoleSetting(..))
19+
import Tldr.Types (ConsoleSetting(..), ColorSetting (..))
2020
import qualified Data.Text as T
2121
import qualified Data.Text.IO as TIO
2222

@@ -35,14 +35,17 @@ defConsoleSetting =
3535
headingSetting :: ConsoleSetting
3636
headingSetting = defConsoleSetting {consoleIntensity = BoldIntensity}
3737

38-
toSGR :: ConsoleSetting -> [SGR]
39-
toSGR cons =
40-
[ SetItalicized (italic cons)
41-
, SetConsoleIntensity (consoleIntensity cons)
42-
, SetUnderlining (underline cons)
43-
, SetBlinkSpeed (blink cons)
44-
, SetColor Foreground (fgIntensity cons) (fgColor cons)
45-
]
38+
toSGR :: ColorSetting -> ConsoleSetting -> [SGR]
39+
toSGR color cons = case color of
40+
NoColor -> def
41+
UseColor -> SetColor Foreground (fgIntensity cons) (fgColor cons) : def
42+
where
43+
def =
44+
[ SetItalicized (italic cons)
45+
, SetConsoleIntensity (consoleIntensity cons)
46+
, SetUnderlining (underline cons)
47+
, SetBlinkSpeed (blink cons)
48+
]
4649

4750
renderNode :: NodeType -> Handle -> IO ()
4851
renderNode (TEXT txt) handle = TIO.hPutStrLn handle (txt <> "\n")
@@ -54,13 +57,13 @@ renderNode LINEBREAK handle = TIO.hPutStrLn handle ""
5457
renderNode (LIST _) handle = TIO.hPutStrLn handle "" >> TIO.hPutStr handle " - "
5558
renderNode _ _ = return ()
5659

57-
changeConsoleSetting :: NodeType -> IO ()
58-
changeConsoleSetting (HEADING _) = setSGR $ toSGR headingSetting
59-
changeConsoleSetting BLOCK_QUOTE = setSGR $ toSGR headingSetting
60-
changeConsoleSetting ITEM = setSGR $ toSGR $ defConsoleSetting {fgColor = Green}
61-
changeConsoleSetting (CODE _) =
62-
setSGR $ toSGR $ defConsoleSetting {fgColor = Yellow}
63-
changeConsoleSetting _ = return ()
60+
changeConsoleSetting :: ColorSetting -> NodeType -> IO ()
61+
changeConsoleSetting color (HEADING _) = setSGR $ toSGR color headingSetting
62+
changeConsoleSetting color BLOCK_QUOTE = setSGR $ toSGR color headingSetting
63+
changeConsoleSetting color ITEM = setSGR $ toSGR color $ defConsoleSetting {fgColor = Green}
64+
changeConsoleSetting color (CODE _) =
65+
setSGR $ toSGR color $ defConsoleSetting {fgColor = Yellow}
66+
changeConsoleSetting _ _ = return ()
6467

6568
handleSubsetNodeType :: NodeType -> Text
6669
handleSubsetNodeType (HTML_BLOCK txt) = txt
@@ -79,16 +82,16 @@ handleParagraph :: [Node] -> Handle -> IO ()
7982
handleParagraph xs handle =
8083
TIO.hPutStrLn handle $ T.concat $ Prelude.map handleSubsetNode xs
8184

82-
handleNode :: Node -> Handle -> IO ()
83-
handleNode (Node _ PARAGRAPH xs) handle = handleParagraph xs handle
84-
handleNode (Node _ ITEM xs) handle =
85-
changeConsoleSetting ITEM >> handleParagraph xs handle
86-
handleNode (Node _ ntype xs) handle = do
87-
changeConsoleSetting ntype
85+
handleNode :: Node -> Handle -> ColorSetting -> IO ()
86+
handleNode (Node _ PARAGRAPH xs) handle _ = handleParagraph xs handle
87+
handleNode (Node _ ITEM xs) handle color =
88+
changeConsoleSetting color ITEM >> handleParagraph xs handle
89+
handleNode (Node _ ntype xs) handle color = do
90+
changeConsoleSetting color ntype
8891
renderNode ntype handle
8992
mapM_
9093
(\(Node _ ntype' ns) ->
91-
renderNode ntype' handle >> mapM_ (`handleNode` handle) ns)
94+
renderNode ntype' handle >> mapM_ (\n -> handleNode n handle color) ns)
9295
xs
9396
setSGR [Reset]
9497

@@ -98,7 +101,7 @@ parsePage fname = do
98101
let node = commonmarkToNode [] page
99102
return node
100103

101-
renderPage :: FilePath -> Handle -> IO ()
102-
renderPage fname handle = do
104+
renderPage :: FilePath -> Handle -> ColorSetting -> IO ()
105+
renderPage fname handle color = do
103106
node <- parsePage fname
104-
handleNode node handle
107+
handleNode node handle color

‎src/Tldr/App.hs‎

Lines changed: 20 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,7 @@ import Control.Monad (void)
1717

1818
programOptions :: Parser TldrOpts
1919
programOptions =
20-
TldrOpts <$> (updateIndexCommand <|> viewPageCommand <|> aboutFlag) <*> autoUpdateIntervalOpt
20+
TldrOpts <$> (updateIndexCommand <|> viewPageCommand <|> aboutFlag) <*> autoUpdateIntervalOpt <*> colorFlags
2121

2222
updateIndexCommand :: Parser TldrCommand
2323
updateIndexCommand =
@@ -64,6 +64,25 @@ languageFlag =
6464
help
6565
"Preferred language for the page returned"))
6666

67+
useColorFlag :: Parser (Maybe ColorSetting)
68+
useColorFlag =
69+
optional
70+
(flag' UseColor
71+
(long "color" <>
72+
help
73+
"Force colored output, overriding the NO_COLOR environment variable"))
74+
75+
noColorFlag :: Parser (Maybe ColorSetting)
76+
noColorFlag =
77+
optional
78+
(flag' NoColor
79+
(long "no-color" <>
80+
help
81+
"Disable colored output"))
82+
83+
colorFlags :: Parser (Maybe ColorSetting)
84+
colorFlags = useColorFlag <|> noColorFlag
85+
6786
tldrParserInfo :: ParserInfo TldrOpts
6887
tldrParserInfo =
6988
info

‎src/Tldr/App/Handler.hs‎

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ module Tldr.App.Handler
1515

1616
import Data.Char (toLower)
1717
import Data.List (intercalate)
18+
import Data.Maybe (fromMaybe)
1819
import Data.Semigroup ((<>))
1920
import qualified Data.Set as Set
2021
import Data.Version (showVersion)
@@ -79,7 +80,10 @@ handleTldrOpts opts@TldrOpts {..} =
7980
Just lg -> pure $ computeLocale (Just lg)
8081
fname <- getPagePath locale npage (getCheckDirs voptions)
8182
case fname of
82-
Just path -> renderPage path stdout
83+
Just path -> do
84+
defColor <- getNoColorEnv
85+
let color = fromMaybe defColor colorSetting
86+
renderPage path stdout color
8387
Nothing ->
8488
if checkLocale locale
8589
then do
@@ -149,6 +153,12 @@ getCheckDirs voptions =
149153
Nothing -> checkDirs
150154
Just platform -> nubOrd $ ["common", platform] <> checkDirs
151155

156+
getNoColorEnv :: IO ColorSetting
157+
getNoColorEnv = do
158+
noColorSet <- lookupEnv "NO_COLOR"
159+
return $ case noColorSet of
160+
Just _ -> NoColor
161+
Nothing -> UseColor
152162

153163
-- | Strip out duplicates
154164
nubOrd :: Ord a => [a] -> [a]

‎src/Tldr/Types.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,9 @@ import System.Console.ANSI
44

55
data Locale = English | Missing | Other String | Unknown String
66

7+
data ColorSetting = NoColor | UseColor
8+
deriving (Eq, Show, Ord, Enum, Bounded)
9+
710
data ConsoleSetting =
811
ConsoleSetting
912
{ italic :: Bool
@@ -18,6 +21,7 @@ data ConsoleSetting =
1821
data TldrOpts = TldrOpts
1922
{ tldrAction :: TldrCommand
2023
, autoUpdateInterval :: Maybe Int
24+
, colorSetting :: Maybe ColorSetting
2125
} deriving (Show)
2226

2327
data TldrCommand

‎test/Spec.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
import Tldr
2+
import Tldr.Types (ColorSetting(..))
23
import Test.Tasty
34
import Test.Tasty.Golden (goldenVsFile)
45
import System.IO (withBinaryFile, IOMode(..))
@@ -12,7 +13,7 @@ goldenTests = testGroup "Golden tests" [gtests]
1213

1314
renderPageToFile :: FilePath -> FilePath -> IO ()
1415
renderPageToFile mdfile opfile = do
15-
withBinaryFile opfile WriteMode (\handle -> renderPage mdfile handle)
16+
withBinaryFile opfile WriteMode (\handle -> renderPage mdfile handle UseColor)
1617

1718
-- For adding new command, you need to add:
1819
-- A new ".md" file for that command

‎tldr.cabal‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,13 @@
11
cabal-version: 1.12
22

3-
-- This file has been generated from package.yaml by hpack version 0.33.0.
3+
-- This file has been generated from package.yaml by hpack version 0.34.4.
44
--
55
-- see: https://github.com/sol/hpack
66
--
7-
-- hash: 8f1a3267eb79f7615c0d4cc731807ebde3d23a3dea7fc605e0dd77b39c458d9e
7+
-- hash: 86d07459291589175c3f2f48f7b55186411b1b57c3a9b1e89abc1df51c9c7f38
88

99
name: tldr
10-
version: 0.9.0
10+
version: 0.9.1
1111
synopsis: Haskell tldr client
1212
description: Haskell tldr client with support for viewing tldr pages. Has offline
1313
cache for accessing pages. Visit https://tldr.sh for more details.

0 commit comments

Comments
 (0)