Skip to content

Commit 0ac2f70

Browse files
psibipsibi
authored
Merge pull request #43 from hasufell/better-coloring
Apply better coloring
2 parents 47c5230 + 753ac6c commit 0ac2f70

File tree

6 files changed

+146
-23
lines changed

6 files changed

+146
-23
lines changed

‎package.yaml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -26,6 +26,7 @@ flags:
2626
library:
2727
source-dirs: src
2828
dependencies:
29+
- attoparsec
2930
- base >=4.7 && <5
3031
- cmark
3132
- text

‎src/Tldr.hs

Lines changed: 32 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE LambdaCase #-}
23

34
module Tldr
45
( parsePage
@@ -12,10 +13,13 @@ module Tldr
1213
) where
1314

1415
import CMark
16+
import Control.Monad (forM_)
17+
import Data.Attoparsec.Text
1518
import Data.Monoid ((<>))
1619
import Data.Text hiding (cons)
1720
import GHC.IO.Handle (Handle)
1821
import System.Console.ANSI
22+
import Tldr.Parser
1923
import Tldr.Types (ConsoleSetting(..), ColorSetting (..))
2024
import qualified Data.Text as T
2125
import qualified Data.Text.IO as TIO
@@ -47,15 +51,31 @@ toSGR color cons = case color of
4751
, SetBlinkSpeed (blink cons)
4852
]
4953

50-
renderNode :: NodeType -> Handle -> IO ()
51-
renderNode (TEXT txt) handle = TIO.hPutStrLn handle (txt <> "\n")
52-
renderNode (HTML_BLOCK txt) handle = TIO.hPutStrLn handle txt
53-
renderNode (CODE_BLOCK _ txt) handle = TIO.hPutStrLn handle txt
54-
renderNode (HTML_INLINE txt) handle = TIO.hPutStrLn handle txt
55-
renderNode (CODE txt) handle = TIO.hPutStrLn handle (" " <> txt)
56-
renderNode LINEBREAK handle = TIO.hPutStrLn handle ""
57-
renderNode (LIST _) handle = TIO.hPutStrLn handle "" >> TIO.hPutStr handle " - "
58-
renderNode _ _ = return ()
54+
reset :: ColorSetting -> IO ()
55+
reset color = case color of
56+
NoColor -> pure ()
57+
UseColor -> setSGR [Reset]
58+
59+
renderNode :: NodeType -> ColorSetting -> Handle -> IO ()
60+
renderNode nt@(TEXT txt) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle (txt <> "\n") >> reset color
61+
renderNode nt@(HTML_BLOCK txt) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle txt >> reset color
62+
renderNode nt@(CODE_BLOCK _ txt) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle txt >> reset color
63+
renderNode nt@(HTML_INLINE txt) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle txt >> reset color
64+
renderNode (CODE txt) color handle = renderCode color txt handle
65+
renderNode nt@LINEBREAK color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle "" >> reset color
66+
renderNode nt@(LIST _) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle "" >> TIO.hPutStr handle " - " >> reset color
67+
renderNode _ _ _ = return ()
68+
69+
renderCode :: ColorSetting -> Text -> Handle -> IO ()
70+
renderCode color txt handle = do
71+
TIO.hPutStr handle (" ")
72+
case parseOnly codeParser txt of
73+
Right xs -> do
74+
forM_ xs $ \case
75+
Left x -> changeConsoleSetting color (CODE txt) >> TIO.hPutStr handle x >> reset color
76+
Right x -> TIO.hPutStr handle x
77+
Left _ -> changeConsoleSetting color (CODE txt) >> TIO.hPutStr handle txt >> reset color
78+
TIO.hPutStr handle ("\n")
5979

6080
changeConsoleSetting :: ColorSetting -> NodeType -> IO ()
6181
changeConsoleSetting color (HEADING _) = setSGR $ toSGR color headingSetting
@@ -87,13 +107,12 @@ handleNode (Node _ PARAGRAPH xs) handle _ = handleParagraph xs handle
87107
handleNode (Node _ ITEM xs) handle color =
88108
changeConsoleSetting color ITEM >> handleParagraph xs handle
89109
handleNode (Node _ ntype xs) handle color = do
90-
changeConsoleSetting color ntype
91-
renderNode ntype handle
110+
renderNode ntype color handle
92111
mapM_
93112
(\(Node _ ntype' ns) ->
94-
renderNode ntype' handle >> mapM_ (\n -> handleNode n handle color) ns)
113+
renderNode ntype' color handle >> mapM_ (\n -> handleNode n handle color) ns)
95114
xs
96-
setSGR [Reset]
115+
reset color
97116

98117
parsePage :: FilePath -> IO Node
99118
parsePage fname = do

‎src/Tldr/Parser.hs

Lines changed: 101 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,101 @@
1+
{-# LANGUAGE LambdaCase #-}
2+
{-# LANGUAGE BangPatterns #-}
3+
4+
module Tldr.Parser where
5+
6+
import Prelude hiding (takeWhile)
7+
import Control.Applicative
8+
import Data.Attoparsec.Combinator
9+
import Data.Attoparsec.Text
10+
import Data.Text (Text)
11+
12+
import qualified Data.Text as T
13+
14+
-- $setup
15+
-- >>> :set -XOverloadedStrings
16+
-- >>> import Data.Attoparsec.Text
17+
18+
19+
-- | Parses '{{foo}}' blocks in CommonMark Code, such that:
20+
--
21+
-- * `ls {{foo}} bar` -> `[Left "ls ", Right "foo", Left " bar"]`
22+
--
23+
-- >>> parseOnly codeParser ""
24+
-- Right []
25+
-- >>> parseOnly codeParser "tar"
26+
-- Right [Left "tar"]
27+
-- >>> parseOnly codeParser "tar{"
28+
-- Right [Left "tar{"]
29+
-- >>> parseOnly codeParser "tar{{"
30+
-- Right [Left "tar{{"]
31+
-- >>> parseOnly codeParser "tar{{{"
32+
-- Right [Left "tar{{{"]
33+
-- >>> parseOnly codeParser "tar}"
34+
-- Right [Left "tar}"]
35+
-- >>> parseOnly codeParser "tar{{{b}"
36+
-- Right [Left "tar{{{b}"]
37+
-- >>> parseOnly codeParser "tar{{{b}}"
38+
-- Right [Left "tar",Right "{b"]
39+
-- >>> parseOnly codeParser "tar{{b}}}"
40+
-- Right [Left "tar",Right "b}"]
41+
-- >>> parseOnly codeParser "tar xf {{source.tar[.gz|.bz2|.xz]}} --directory={{directory}}"
42+
-- Right [Left "tar xf ",Right "source.tar[.gz|.bz2|.xz]",Left " --directory=",Right "directory"]
43+
codeParser :: Parser [Either Text Text]
44+
codeParser = collectEither <$> outer
45+
where
46+
inner :: Parser [Either Text Text]
47+
inner = do
48+
_ <- char '{'
49+
_ <- char '{'
50+
l <- takeWhile (/= '}')
51+
e <- optional findEnd
52+
case e of
53+
Just e' -> (\o -> [Right (l <> e') ] <> o) <$> (outer <|> pure [])
54+
Nothing -> (\o -> [Left (T.pack "{{" <> l)] <> o) <$> (outer <|> pure [])
55+
where
56+
findEnd :: Parser Text
57+
findEnd = do
58+
c1 <- anyChar
59+
(p2, p3) <- peek2Chars
60+
case (c1, p2, p3) of
61+
('}', Just '}', Just '}') -> (T.singleton '}' <>) <$> findEnd
62+
('}', Just '}', _) -> mempty <$ anyChar
63+
_ -> fail ("Couldn't find end: " <> show (c1, p2, p3))
64+
65+
outer :: Parser [Either Text Text]
66+
outer = do
67+
o <- takeWhile (/= '{')
68+
(p1, p2) <- peek2Chars
69+
case (p1, p2) of
70+
(Just '{', Just '{') -> (\i -> [Left o ] <> i) <$> (inner <|> ((\t -> [Left t]) <$> takeText))
71+
(Just '{', _) -> (\a b -> [Left (o <> T.singleton a)] <> b) <$> anyChar <*> outer
72+
_ -> pure [Left o]
73+
74+
75+
-- | Collect both Lefts and Rights, mappending them to zore or one item per connected sublist.
76+
--
77+
-- >>> collectEither []
78+
-- []
79+
-- >>> collectEither [Right "abc", Right "def", Left "x", Left "z", Right "end"]
80+
-- [Right "abcdef",Left "xz",Right "end"]
81+
-- >>> collectEither [Right "", Right "def", Left "x", Left "", Right ""]
82+
-- [Right "def",Left "x"]
83+
collectEither :: (Eq a, Eq b, Monoid a, Monoid b) => [Either a b] -> [Either a b]
84+
collectEither = go Nothing
85+
where
86+
go Nothing [] = []
87+
go (Just !x) []
88+
| x == Right mempty || x == Left mempty = []
89+
| otherwise = [x]
90+
go Nothing (Left b:br) = go (Just (Left b)) br
91+
go Nothing (Right b:br) = go (Just (Right b)) br
92+
go (Just (Left !a)) (Left b:br) = go (Just (Left (a <> b))) br
93+
go (Just (Right !a)) (Right b:br) = go (Just (Right (a <> b))) br
94+
go (Just !a) xs
95+
| a == Right mempty || a == Left mempty = go Nothing xs
96+
| otherwise = a:go Nothing xs
97+
98+
99+
-- | Peek 2 characters, not consuming any input.
100+
peek2Chars :: Parser (Maybe Char, Maybe Char)
101+
peek2Chars = lookAhead ((,) <$> optional anyChar <*> optional anyChar)

‎test/data/grep.golden

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -4,25 +4,25 @@ Matches patterns in input text.
44
Supports simple patterns and regular expressions.
55

66
- Search for an exact string:
7-
grep {{search_string}} {{path/to/file}}
7+
grep search_string path/to/file
88

99
- Search in case-insensitive mode:
10-
grep -i {{search_string}} {{path/to/file}}
10+
grep -i search_string path/to/file
1111

1212
- Search recursively (ignoring non-text files) in current directory for an exact string:
13-
grep -RI {{search_string}} .
13+
grep -RI search_string .
1414

1515
- Use extended regular expressions (supporting ?, +, {}, () and |):
16-
grep -E {{^regex$}} {{path/to/file}}
16+
grep -E ^regex$ path/to/file
1717

1818
- Print 3 lines of [C]ontext around, [B]efore, or [A]fter each match:
19-
grep -{{C|B|A}} 3 {{search_string}} {{path/to/file}}
19+
grep -C|B|A 3 search_string path/to/file
2020

2121
- Print file name with the corresponding line number for each match:
22-
grep -Hn {{search_string}} {{path/to/file}}
22+
grep -Hn search_string path/to/file
2323

2424
- Use the standard input instead of a file:
25-
cat {{path/to/file}} | grep {{search_string}}
25+
cat path/to/file | grep search_string
2626

2727
- Invert match for excluding specific strings:
28-
grep -v {{search_string}}
28+
grep -v search_string

‎test/data/ps.golden

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ Information about running processes.
99
ps auxww
1010

1111
- Search for a process that matches a string:
12-
ps aux | grep {{string}}
12+
ps aux | grep string
1313

1414
- List all processes of the current user in extra full format:
1515
ps --user $(id -u) -F
@@ -18,4 +18,4 @@ Information about running processes.
1818
ps --user $(id -u) f
1919

2020
- Get the parent pid of a process:
21-
ps -o ppid= -p {{pid}}
21+
ps -o ppid= -p pid

‎tldr.cabal

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,7 @@ library
4545
Tldr.App
4646
Tldr.App.Constant
4747
Tldr.App.Handler
48+
Tldr.Parser
4849
Tldr.Types
4950
other-modules:
5051
Paths_tldr
@@ -53,6 +54,7 @@ library
5354
ghc-options: -Wall -O2
5455
build-depends:
5556
ansi-terminal
57+
, attoparsec
5658
, base >=4.7 && <5
5759
, bytestring
5860
, cmark

0 commit comments

Comments
 (0)