tldr 0.9.1 → 0.9.2

raw patch · 10 files changed

+158/−34 lines, 10 filesdep +attoparsec

Dependencies added: attoparsec

Files

• CHANGELOG.md +4/−0
• src/Tldr.hs +32/−13
• src/Tldr/App.hs +1/−1
• src/Tldr/App/Handler.hs +5/−5
• src/Tldr/Parser.hs +101/−0
• src/Tldr/Types.hs +1/−1
• test/Spec.hs +1/−1
• test/data/grep.golden +8/−8
• test/data/ps.golden +2/−2
• tldr.cabal +3/−3

@@ -1,3 +1,7 @@+# 0.9.2++* [Apply better coloring](https://github.com/psibi/tldr-hs/pull/43 "https://github.com/psibi/tldr-hs/pull/43")+ # 0.9.1  * When the [`NO_COLOR`](https://no-color.org/) environment variable is set, the client will not color the output.

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE LambdaCase #-}  module Tldr   ( parsePage@@ -12,10 +13,13 @@   ) where  import CMark+import Control.Monad (forM_)+import Data.Attoparsec.Text import Data.Monoid ((<>)) import Data.Text hiding (cons) import GHC.IO.Handle (Handle) import System.Console.ANSI+import Tldr.Parser import Tldr.Types (ConsoleSetting(..), ColorSetting (..)) import qualified Data.Text as T import qualified Data.Text.IO as TIO@@ -47,16 +51,32 @@       , SetBlinkSpeed (blink cons)       ] -renderNode :: NodeType -> Handle -> IO ()-renderNode (TEXT txt) handle = TIO.hPutStrLn handle (txt <> "\n")-renderNode (HTML_BLOCK txt) handle = TIO.hPutStrLn handle txt-renderNode (CODE_BLOCK _ txt) handle = TIO.hPutStrLn handle txt-renderNode (HTML_INLINE txt) handle = TIO.hPutStrLn handle txt-renderNode (CODE txt) handle = TIO.hPutStrLn handle ("   " <> txt)-renderNode LINEBREAK handle = TIO.hPutStrLn handle ""-renderNode (LIST _) handle = TIO.hPutStrLn handle "" >> TIO.hPutStr handle " - "-renderNode _ _ = return ()+reset :: ColorSetting -> IO ()+reset color = case color of+  NoColor -> pure ()+  UseColor -> setSGR [Reset] +renderNode :: NodeType -> ColorSetting -> Handle -> IO ()+renderNode nt@(TEXT txt) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle (txt <> "\n") >> reset color+renderNode nt@(HTML_BLOCK txt) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle txt >> reset color+renderNode nt@(CODE_BLOCK _ txt) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle txt >> reset color+renderNode nt@(HTML_INLINE txt) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle txt >> reset color+renderNode (CODE txt) color handle = renderCode color txt handle+renderNode nt@LINEBREAK color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle "" >> reset color+renderNode nt@(LIST _) color handle = changeConsoleSetting color nt >> TIO.hPutStrLn handle "" >> TIO.hPutStr handle " - " >> reset color+renderNode _ _ _ = return ()++renderCode :: ColorSetting -> Text -> Handle -> IO ()+renderCode color txt handle = do+  TIO.hPutStr handle ("   ")+  case parseOnly codeParser txt of+    Right xs -> do+      forM_ xs $ \case+        Left x -> changeConsoleSetting color (CODE txt) >> TIO.hPutStr handle x >> reset color+        Right x -> TIO.hPutStr handle x+    Left _ -> changeConsoleSetting color (CODE txt) >> TIO.hPutStr handle txt >> reset color+  TIO.hPutStr handle ("\n")+ changeConsoleSetting :: ColorSetting -> NodeType -> IO () changeConsoleSetting color (HEADING _) = setSGR $ toSGR color headingSetting changeConsoleSetting color BLOCK_QUOTE = setSGR $ toSGR color headingSetting@@ -87,13 +107,12 @@ handleNode (Node _ ITEM xs) handle color =   changeConsoleSetting color ITEM >> handleParagraph xs handle handleNode (Node _ ntype xs) handle color = do-  changeConsoleSetting color ntype-  renderNode ntype handle+  renderNode ntype color handle   mapM_     (\(Node _ ntype' ns) ->-       renderNode ntype' handle >> mapM_ (\n -> handleNode n handle color) ns)+       renderNode ntype' color handle >> mapM_ (\n -> handleNode n handle color) ns)     xs-  setSGR [Reset]+  reset color  parsePage :: FilePath -> IO Node parsePage fname = do

@@ -78,7 +78,7 @@     (flag' NoColor         (long "no-color" <>         help-          "Disable colored output")) +          "Disable colored output"))  colorFlags :: Parser (Maybe ColorSetting) colorFlags = useColorFlag <|> noColorFlag

@@ -72,7 +72,7 @@     About -> handleAboutFlag     ViewPage voptions pages -> do       shouldPerformUpdate <- updateNecessary opts-      when shouldPerformUpdate updateTldrPages +      when shouldPerformUpdate updateTldrPages       let npage = intercalate "-" pages       locale <-         case languageOption voptions of@@ -82,7 +82,7 @@       case fname of         Just path -> do           defColor <- getNoColorEnv-          let color = fromMaybe defColor colorSetting +          let color = fromMaybe defColor colorSetting           renderPage path stdout color         Nothing ->           if checkLocale locale@@ -99,13 +99,13 @@ updateNecessary TldrOpts{..} = do   dataDir <- getXdgDirectory XdgData tldrDirName   dataDirExists <- doesDirectoryExist dataDir-  if not dataDirExists +  if not dataDirExists     then return True     else do       lastCachedTime <- getModificationTime dataDir       currentTime <- getCurrentTime-      let diffExceedsLimit limit -            = currentTime `diffUTCTime` lastCachedTime +      let diffExceedsLimit limit+            = currentTime `diffUTCTime` lastCachedTime               > fromIntegral limit * nominalDay       return $ maybe False diffExceedsLimit autoUpdateInterval 

@@ -0,0 +1,101 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE BangPatterns #-}++module Tldr.Parser where++import Prelude              hiding (takeWhile)+import Control.Applicative+import Data.Attoparsec.Combinator+import Data.Attoparsec.Text+import Data.Text                   (Text)++import qualified Data.Text as T++-- $setup+-- >>> :set -XOverloadedStrings+-- >>> import Data.Attoparsec.Text+++-- | Parses '{{foo}}' blocks in CommonMark Code, such that:+--+-- * `ls {{foo}} bar` -> `[Left "ls ", Right "foo", Left " bar"]`+--+-- >>> parseOnly codeParser ""+-- Right []+-- >>> parseOnly codeParser "tar"+-- Right [Left "tar"]+-- >>> parseOnly codeParser "tar{"+-- Right [Left "tar{"]+-- >>> parseOnly codeParser "tar{{"+-- Right [Left "tar{{"]+-- >>> parseOnly codeParser "tar{{{"+-- Right [Left "tar{{{"]+-- >>> parseOnly codeParser "tar}"+-- Right [Left "tar}"]+-- >>> parseOnly codeParser "tar{{{b}"+-- Right [Left "tar{{{b}"]+-- >>> parseOnly codeParser "tar{{{b}}"+-- Right [Left "tar",Right "{b"]+-- >>> parseOnly codeParser "tar{{b}}}"+-- Right [Left "tar",Right "b}"]+-- >>> parseOnly codeParser "tar xf {{source.tar[.gz|.bz2|.xz]}} --directory={{directory}}"+-- Right [Left "tar xf ",Right "source.tar[.gz|.bz2|.xz]",Left " --directory=",Right "directory"]+codeParser :: Parser [Either Text Text]+codeParser = collectEither <$> outer+ where+  inner :: Parser [Either Text Text]+  inner = do+    _ <- char '{'+    _ <- char '{'+    l <- takeWhile (/= '}')+    e <- optional findEnd+    case e of+      Just e' -> (\o -> [Right (l <> e')         ] <> o) <$> (outer <|> pure [])+      Nothing -> (\o -> [Left  (T.pack "{{" <> l)] <> o) <$> (outer <|> pure [])+   where+    findEnd :: Parser Text+    findEnd = do+      c1 <- anyChar+      (p2, p3) <- peek2Chars+      case (c1, p2, p3) of+        ('}', Just '}', Just '}') -> (T.singleton '}' <>) <$> findEnd+        ('}', Just '}', _)        -> mempty <$ anyChar+        _                         -> fail ("Couldn't find end: " <> show (c1, p2, p3))++  outer :: Parser [Either Text Text]+  outer = do+    o  <- takeWhile (/= '{')+    (p1, p2) <- peek2Chars+    case (p1, p2) of+      (Just '{', Just '{') -> (\i   -> [Left o                   ] <> i) <$> (inner <|> ((\t -> [Left t]) <$> takeText))+      (Just '{', _)        -> (\a b -> [Left (o <> T.singleton a)] <> b) <$> anyChar <*> outer+      _                    -> pure [Left o]+++-- | Collect both Lefts and Rights, mappending them to zore or one item per connected sublist.+--+-- >>> collectEither []+-- []+-- >>> collectEither [Right "abc", Right "def", Left "x", Left "z", Right "end"]+-- [Right "abcdef",Left "xz",Right "end"]+-- >>> collectEither [Right "", Right "def", Left "x", Left "", Right ""]+-- [Right "def",Left "x"]+collectEither :: (Eq a, Eq b, Monoid a, Monoid b) => [Either a b] -> [Either a b]+collectEither = go Nothing+ where+  go Nothing  [] = []+  go (Just !x) []+    | x == Right mempty || x == Left mempty = []+    | otherwise                             = [x]+  go Nothing           (Left  b:br) = go (Just (Left  b))        br+  go Nothing           (Right b:br) = go (Just (Right b))        br+  go (Just (Left !a))  (Left  b:br) = go (Just (Left (a <> b)))  br+  go (Just (Right !a)) (Right b:br) = go (Just (Right (a <> b))) br+  go (Just !a) xs+    | a == Right mempty || a == Left mempty = go Nothing xs+    | otherwise                             = a:go Nothing xs+++-- | Peek 2 characters, not consuming any input.+peek2Chars :: Parser (Maybe Char, Maybe Char)+peek2Chars = lookAhead ((,) <$> optional anyChar <*> optional anyChar)

@@ -4,7 +4,7 @@  data Locale = English | Missing | Other String | Unknown String -data ColorSetting = NoColor | UseColor +data ColorSetting = NoColor | UseColor   deriving (Eq, Show, Ord, Enum, Bounded)  data ConsoleSetting =

@@ -28,7 +28,7 @@       md cmd = prefix <> cmd <> ".md"  gtests :: TestTree-gtests = testGroup "(render test)" +gtests = testGroup "(render test)"          [           commandTest "ls"          , commandTest "ps"

@@ -4,25 +4,25 @@ Supports simple patterns and regular expressions.   - Search for an exact string:-   grep {{search_string}} {{path/to/file}}+   grep search_string path/to/file   - Search in case-insensitive mode:-   grep -i {{search_string}} {{path/to/file}}+   grep -i search_string path/to/file   - Search recursively (ignoring non-text files) in current directory for an exact string:-   grep -RI {{search_string}} .+   grep -RI search_string .   - Use extended regular expressions (supporting ?, +, {}, () and |):-   grep -E {{^regex$}} {{path/to/file}}+   grep -E ^regex$ path/to/file   - Print 3 lines of [C]ontext around, [B]efore, or [A]fter each match:-   grep -{{C|B|A}} 3 {{search_string}} {{path/to/file}}+   grep -C|B|A 3 search_string path/to/file   - Print file name with the corresponding line number for each match:-   grep -Hn {{search_string}} {{path/to/file}}+   grep -Hn search_string path/to/file   - Use the standard input instead of a file:-   cat {{path/to/file}} | grep {{search_string}}+   cat path/to/file | grep search_string   - Invert match for excluding specific strings:-   grep -v {{search_string}}+   grep -v search_string

@@ -9,7 +9,7 @@    ps auxww   - Search for a process that matches a string:-   ps aux | grep {{string}}+   ps aux | grep string   - List all processes of the current user in extra full format:    ps --user $(id -u) -F@@ -18,4 +18,4 @@    ps --user $(id -u) f   - Get the parent pid of a process:-   ps -o ppid= -p {{pid}}+   ps -o ppid= -p pid

@@ -3,11 +3,9 @@ -- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack------ hash: 86d07459291589175c3f2f48f7b55186411b1b57c3a9b1e89abc1df51c9c7f38  name:           tldr-version:        0.9.1+version:        0.9.2 synopsis:       Haskell tldr client description:    Haskell tldr client with support for viewing tldr pages. Has offline                 cache for accessing pages. Visit https://tldr.sh for more details.@@ -45,6 +43,7 @@       Tldr.App       Tldr.App.Constant       Tldr.App.Handler+      Tldr.Parser       Tldr.Types   other-modules:       Paths_tldr@@ -53,6 +52,7 @@   ghc-options: -Wall -O2   build-depends:       ansi-terminal+    , attoparsec     , base >=4.7 && <5     , bytestring     , cmark