From b2917db7c571937895ad03b5d0307da4f7ec0cd2 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Tue, 4 Aug 2020 18:51:13 +0530 Subject: [PATCH 1/5] Re-organize --- app/Main.hs | 234 +-------------------------------------- package.yaml | 15 ++- src/Tldr.hs | 12 +- src/Tldr/App.hs | 88 +++++++++++++++ src/Tldr/App/Constant.hs | 13 +++ src/Tldr/App/Handler.hs | 141 +++++++++++++++++++++++ src/Tldr/Types.hs | 34 ++++++ tldr.cabal | 20 ++-- 8 files changed, 299 insertions(+), 258 deletions(-) create mode 100644 src/Tldr/App.hs create mode 100644 src/Tldr/App/Constant.hs create mode 100644 src/Tldr/App/Handler.hs create mode 100644 src/Tldr/Types.hs diff --git a/app/Main.hs b/app/Main.hs index e44926d..961012d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,234 +1,6 @@ -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE BangPatterns #-} +module Main where -module Main - ( main - ) where - -import Control.Monad -import Data.List (intercalate) -import Data.Semigroup ((<>)) -import qualified Data.Set as Set -import Data.Version (showVersion) -import System.IO (stdout, stderr, hPutStrLn) -import Options.Applicative -import Paths_tldr (version) -import System.Directory -import System.Environment (getArgs, getExecutablePath, lookupEnv) -import System.Exit (exitFailure) -import System.FilePath -import System.Process.Typed -import Data.Char (toLower) -import Tldr - -data TldrOpts = TldrOpts - { tldrAction :: TldrCommand - } deriving (Show) - -data TldrCommand - = UpdateIndex - | ViewPage ViewOptions - [String] - | About - deriving (Show, Eq, Ord) - -data ViewOptions = - ViewOptions - { platformOption :: Maybe String - , languageOption :: Maybe String - } - deriving (Show, Eq, Ord) - -englishViewOptions :: ViewOptions -> ViewOptions -englishViewOptions xs = xs { languageOption = Just "en_US.utf8" } - -programOptions :: Parser TldrOpts -programOptions = - (TldrOpts <$> (updateIndexCommand <|> viewPageCommand <|> aboutFlag)) - -updateIndexCommand :: Parser TldrCommand -updateIndexCommand = - flag' - UpdateIndex - (long "update" <> short 'u' <> help "Update offline cache of tldr pages") - -aboutFlag :: Parser TldrCommand -aboutFlag = flag' About (long "about" <> short 'a' <> help "About this program") - -viewOptionsParser :: Parser ViewOptions -viewOptionsParser = ViewOptions <$> platformFlag <*> languageFlag - -viewPageCommand :: Parser TldrCommand -viewPageCommand = - ViewPage <$> viewOptionsParser <*> - some (strArgument (metavar "COMMAND" <> help "name of the command")) - -platformFlag :: Parser (Maybe String) -platformFlag = - optional - (strOption - (long "platform" <> short 'p' <> metavar "PLATFORM" <> - help - ("Prioritize specfic platform while searching. Valid values include " <> - platformHelpValue))) - where - platformHelpValue :: String - platformHelpValue = intercalate ", " platformDirs - -languageFlag :: Parser (Maybe String) -languageFlag = - optional - (strOption - (long "language" <> short 'L' <> metavar "LOCALE" <> - help - ("Preferred language for the page returned"))) - -tldrDirName :: String -tldrDirName = "tldr" - -repoHttpsUrl :: String -repoHttpsUrl = "https://github.com/tldr-pages/tldr.git" - -checkDirs :: [String] -checkDirs = "common" : platformDirs - -platformDirs :: [String] -platformDirs = ["linux", "osx", "windows", "sunos"] - -tldrInitialized :: IO Bool -tldrInitialized = do - dataDir <- getXdgDirectory XdgData tldrDirName - let dir2 = dataDir "tldr" - pages = dataDir "tldr" "pages" - exists <- mapM doesDirectoryExist [dataDir, dir2, pages] - return $ all (== True) exists - -initializeTldrPages :: IO () -initializeTldrPages = do - initialized <- tldrInitialized - unless initialized $ do - dataDir <- getXdgDirectory XdgData tldrDirName - createDirectoryIfMissing False dataDir - runProcess_ $ setWorkingDir dataDir $ proc "git" ["clone", repoHttpsUrl] - -updateTldrPages :: IO () -updateTldrPages = do - dataDir <- getXdgDirectory XdgData tldrDirName - let repoDir = dataDir "tldr" - repoExists <- doesDirectoryExist repoDir - case repoExists of - True -> - runProcess_ $ - setWorkingDir (repoDir) $ proc "git" ["pull", "origin", "master"] - False -> initializeTldrPages - -tldrParserInfo :: ParserInfo TldrOpts -tldrParserInfo = - info - (helper <*> versionOption <*> programOptions) - (fullDesc <> progDesc "tldr Client program" <> - header "tldr - Simplified and community-driven man pages") - where - versionOption :: Parser (a -> a) - versionOption = - infoOption - (showVersion version) - (long "version" <> short 'v' <> help "Show version") - -pageExists :: FilePath -> IO (Maybe FilePath) -pageExists fname = do - exists <- doesFileExist fname - if exists - then return $ Just fname - else return Nothing - -getPagePath :: Locale -> String -> [String] -> IO (Maybe FilePath) -getPagePath locale page platformDirs = do - dataDir <- getXdgDirectory XdgData tldrDirName - let currentLocale = case locale of - English -> "pages" - Other xs -> "pages." <> xs - Unknown xs -> "pages." <> xs - Missing -> "pages" - pageDir = dataDir "tldr" currentLocale - paths = map (\x -> pageDir x page <.> "md") platformDirs - foldr1 (<|>) <$> mapM pageExists paths - -getCheckDirs :: ViewOptions -> [String] -getCheckDirs voptions = - case platformOption voptions of - Nothing -> checkDirs - Just platform -> nubOrd $ ["common", platform] <> checkDirs - --- | Strip out duplicates -nubOrd :: Ord a => [a] -> [a] -nubOrd = loop mempty - where - loop _ [] = [] - loop !s (a:as) - | a `Set.member` s = loop s as - | otherwise = a : loop (Set.insert a s) as - -handleAboutFlag :: IO () -handleAboutFlag = do - path <- getExecutablePath - let content = - unlines - [ path <> " v" <> (showVersion version) - , "Copyright (C) 2017 Sibi Prabakaran" - , "Source available at https://github.com/psibi/tldr-hs" - ] - putStr content - -handleTldrOpts :: TldrOpts -> IO () -handleTldrOpts opts@TldrOpts {..} = do - case tldrAction of - UpdateIndex -> updateTldrPages - About -> handleAboutFlag - vopts@(ViewPage voptions pages) -> do - let npage = intercalate "-" pages - locale <- - case (languageOption voptions) of - Nothing -> retriveLocale - Just lg -> pure $ computeLocale (Just lg) - fname <- getPagePath locale npage (getCheckDirs voptions) - case fname of - Just path -> renderPage path stdout - Nothing -> do - if checkLocale locale - then do - hPutStrLn stderr ("No tldr entry for " <> (intercalate " " pages)) - exitFailure - else handleTldrOpts - (opts - { tldrAction = - ViewPage (englishViewOptions voptions) pages - }) - -checkLocale :: Locale -> Bool -checkLocale English = True -checkLocale _ = False - -data Locale = English | Missing | Other String | Unknown String - -retriveLocale :: IO Locale -retriveLocale = do - lang <- lookupEnv "LANG" - pure $ computeLocale lang - -computeLocale :: Maybe String -> Locale -computeLocale lang = case map toLower <$> lang of - Nothing -> Missing - Just ('e':'n':_) -> English - Just (a:b:'_':_) -> Other (a:b:[]) - Just (a:b:c:'_':_) -> Other (a:b:c:[]) - Just str -> Unknown str +import Tldr.App (appMain) main :: IO () -main = do - args <- getArgs - case execParserPure (prefs showHelpOnEmpty) tldrParserInfo args of - failOpts@(Failure _) -> handleParseResult failOpts >> return () - Success opts -> handleTldrOpts opts - compOpts@(CompletionInvoked _) -> handleParseResult compOpts >> return () +main = appMain diff --git a/package.yaml b/package.yaml index c6d232e..23f26e6 100644 --- a/package.yaml +++ b/package.yaml @@ -25,14 +25,19 @@ flags: library: source-dirs: src - exposed-modules: - - Tldr dependencies: - base >=4.7 && <5 - cmark - text - bytestring - ansi-terminal + - optparse-applicative + - directory + - filepath + - typed-process + - semigroups + - containers + executables: tldr: @@ -48,12 +53,6 @@ executables: dependencies: - base - tldr - - optparse-applicative - - directory - - filepath - - typed-process - - semigroups - - containers tests: tldr-test: diff --git a/src/Tldr.hs b/src/Tldr.hs index 12638c9..fe97d2b 100644 --- a/src/Tldr.hs +++ b/src/Tldr.hs @@ -18,17 +18,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as TIO import GHC.IO.Handle (Handle) import System.Console.ANSI - -data ConsoleSetting = - ConsoleSetting - { italic :: Bool - , underline :: Underlining - , blink :: BlinkSpeed - , fgIntensity :: ColorIntensity - , fgColor :: Color - , bgIntensity :: ColorIntensity - , consoleIntensity :: ConsoleIntensity - } +import Tldr.Types (ConsoleSetting(..)) defConsoleSetting :: ConsoleSetting defConsoleSetting = diff --git a/src/Tldr/App.hs b/src/Tldr/App.hs new file mode 100644 index 0000000..01cacc9 --- /dev/null +++ b/src/Tldr/App.hs @@ -0,0 +1,88 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RecordWildCards #-} + +module Tldr.App + ( appMain + ) where + +import Control.Monad +import Data.List (intercalate) +import Data.Semigroup ((<>)) +import Tldr.App.Constant +import Data.Version (showVersion) +import System.IO (stdout, stderr, hPutStrLn) +import Options.Applicative +import Paths_tldr (version) +import System.Directory +import System.Environment (getArgs, lookupEnv) +import System.Exit (exitFailure) +import System.FilePath +import System.Process.Typed +import Data.Char (toLower) +import Tldr +import Tldr.App.Handler +import Tldr.Types + + +programOptions :: Parser TldrOpts +programOptions = + (TldrOpts <$> (updateIndexCommand <|> viewPageCommand <|> aboutFlag)) + +updateIndexCommand :: Parser TldrCommand +updateIndexCommand = + flag' + UpdateIndex + (long "update" <> short 'u' <> help "Update offline cache of tldr pages") + +aboutFlag :: Parser TldrCommand +aboutFlag = flag' About (long "about" <> short 'a' <> help "About this program") + +viewOptionsParser :: Parser ViewOptions +viewOptionsParser = ViewOptions <$> platformFlag <*> languageFlag + +viewPageCommand :: Parser TldrCommand +viewPageCommand = + ViewPage <$> viewOptionsParser <*> + some (strArgument (metavar "COMMAND" <> help "name of the command")) + +platformFlag :: Parser (Maybe String) +platformFlag = + optional + (strOption + (long "platform" <> short 'p' <> metavar "PLATFORM" <> + help + ("Prioritize specfic platform while searching. Valid values include " <> + platformHelpValue))) + where + platformHelpValue :: String + platformHelpValue = intercalate ", " platformDirs + +languageFlag :: Parser (Maybe String) +languageFlag = + optional + (strOption + (long "language" <> short 'L' <> metavar "LOCALE" <> + help + ("Preferred language for the page returned"))) + +tldrParserInfo :: ParserInfo TldrOpts +tldrParserInfo = + info + (helper <*> versionOption <*> programOptions) + (fullDesc <> progDesc "tldr Client program" <> + header "tldr - Simplified and community-driven man pages") + where + versionOption :: Parser (a -> a) + versionOption = + infoOption + (showVersion version) + (long "version" <> short 'v' <> help "Show version") + + +appMain :: IO () +appMain = do + args <- getArgs + case execParserPure (prefs showHelpOnEmpty) tldrParserInfo args of + failOpts@(Failure _) -> handleParseResult failOpts >> return () + Success opts -> handleTldrOpts opts + compOpts@(CompletionInvoked _) -> handleParseResult compOpts >> return () diff --git a/src/Tldr/App/Constant.hs b/src/Tldr/App/Constant.hs new file mode 100644 index 0000000..688a246 --- /dev/null +++ b/src/Tldr/App/Constant.hs @@ -0,0 +1,13 @@ +module Tldr.App.Constant where + +tldrDirName :: String +tldrDirName = "tldr" + +repoHttpsUrl :: String +repoHttpsUrl = "https://github.com/tldr-pages/tldr.git" + +checkDirs :: [String] +checkDirs = "common" : platformDirs + +platformDirs :: [String] +platformDirs = ["linux", "osx", "windows", "sunos"] diff --git a/src/Tldr/App/Handler.hs b/src/Tldr/App/Handler.hs new file mode 100644 index 0000000..11584fe --- /dev/null +++ b/src/Tldr/App/Handler.hs @@ -0,0 +1,141 @@ +{-#LANGUAGE RecordWildCards#-} +{-# LANGUAGE BangPatterns #-} + +module Tldr.App.Handler where + +import Data.Version (showVersion) +import qualified Data.Set as Set +import Paths_tldr (version) +import System.Environment (getExecutablePath) +import System.Directory (doesFileExist, XdgDirectory(..), getXdgDirectory, createDirectoryIfMissing, doesDirectoryExist) +import System.FilePath ((), (<.>)) +import System.Process.Typed +import Data.Semigroup ((<>)) +import Options.Applicative +import Data.List (intercalate) +import System.Environment (getArgs, lookupEnv) +import Tldr +import Tldr.Types +import Tldr.App.Constant +import Control.Monad (unless) +import Data.Char (toLower) +import System.Exit (exitFailure) +import System.IO (stdout, stderr, hPutStrLn) + +handleAboutFlag :: IO () +handleAboutFlag = do + path <- getExecutablePath + let content = + unlines + [ path <> " v" <> (showVersion version) + , "Copyright (C) 2017 Sibi Prabakaran" + , "Source available at https://github.com/psibi/tldr-hs" + ] + putStr content + +retriveLocale :: IO Locale +retriveLocale = do + lang <- lookupEnv "LANG" + pure $ computeLocale lang + +checkLocale :: Locale -> Bool +checkLocale English = True +checkLocale _ = False + +englishViewOptions :: ViewOptions -> ViewOptions +englishViewOptions xs = xs { languageOption = Just "en_US.utf8" } + +handleTldrOpts :: TldrOpts -> IO () +handleTldrOpts opts@TldrOpts {..} = do + case tldrAction of + UpdateIndex -> updateTldrPages + About -> handleAboutFlag + vopts@(ViewPage voptions pages) -> do + let npage = intercalate "-" pages + locale <- + case (languageOption voptions) of + Nothing -> retriveLocale + Just lg -> pure $ computeLocale (Just lg) + fname <- getPagePath locale npage (getCheckDirs voptions) + case fname of + Just path -> renderPage path stdout + Nothing -> do + if checkLocale locale + then do + hPutStrLn stderr ("No tldr entry for " <> (intercalate " " pages)) + exitFailure + else handleTldrOpts + (opts + { tldrAction = + ViewPage (englishViewOptions voptions) pages + }) + +updateTldrPages :: IO () +updateTldrPages = do + dataDir <- getXdgDirectory XdgData tldrDirName + let repoDir = dataDir "tldr" + repoExists <- doesDirectoryExist repoDir + case repoExists of + True -> + runProcess_ $ + setWorkingDir (repoDir) $ proc "git" ["pull", "origin", "master"] + False -> initializeTldrPages + +computeLocale :: Maybe String -> Locale +computeLocale lang = case map toLower <$> lang of + Nothing -> Missing + Just ('e':'n':_) -> English + Just (a:b:'_':_) -> Other (a:b:[]) + Just (a:b:c:'_':_) -> Other (a:b:c:[]) + Just str -> Unknown str + +getPagePath :: Locale -> String -> [String] -> IO (Maybe FilePath) +getPagePath locale page platformDirs = do + dataDir <- getXdgDirectory XdgData tldrDirName + let currentLocale = case locale of + English -> "pages" + Other xs -> "pages." <> xs + Unknown xs -> "pages." <> xs + Missing -> "pages" + pageDir = dataDir "tldr" currentLocale + paths = map (\x -> pageDir x page <.> "md") platformDirs + foldr1 (<|>) <$> mapM pageExists paths + +pageExists :: FilePath -> IO (Maybe FilePath) +pageExists fname = do + exists <- doesFileExist fname + if exists + then return $ Just fname + else return Nothing + +tldrInitialized :: IO Bool +tldrInitialized = do + dataDir <- getXdgDirectory XdgData tldrDirName + let dir2 = dataDir "tldr" + pages = dataDir "tldr" "pages" + exists <- mapM doesDirectoryExist [dataDir, dir2, pages] + return $ all (== True) exists + +initializeTldrPages :: IO () +initializeTldrPages = do + initialized <- tldrInitialized + unless initialized $ do + dataDir <- getXdgDirectory XdgData tldrDirName + createDirectoryIfMissing False dataDir + runProcess_ $ setWorkingDir dataDir $ proc "git" ["clone", repoHttpsUrl] + +getCheckDirs :: ViewOptions -> [String] +getCheckDirs voptions = + case platformOption voptions of + Nothing -> checkDirs + Just platform -> nubOrd $ ["common", platform] <> checkDirs + + +-- | Strip out duplicates +nubOrd :: Ord a => [a] -> [a] +nubOrd = loop mempty + where + loop _ [] = [] + loop !s (a:as) + | a `Set.member` s = loop s as + | otherwise = a : loop (Set.insert a s) as diff --git a/src/Tldr/Types.hs b/src/Tldr/Types.hs new file mode 100644 index 0000000..1a9095b --- /dev/null +++ b/src/Tldr/Types.hs @@ -0,0 +1,34 @@ +module Tldr.Types where + +import System.Console.ANSI + +data Locale = English | Missing | Other String | Unknown String + +data ConsoleSetting = + ConsoleSetting + { italic :: Bool + , underline :: Underlining + , blink :: BlinkSpeed + , fgIntensity :: ColorIntensity + , fgColor :: Color + , bgIntensity :: ColorIntensity + , consoleIntensity :: ConsoleIntensity + } + +data TldrOpts = TldrOpts + { tldrAction :: TldrCommand + } deriving (Show) + +data TldrCommand + = UpdateIndex + | ViewPage ViewOptions + [String] + | About + deriving (Show, Eq, Ord) + +data ViewOptions = + ViewOptions + { platformOption :: Maybe String + , languageOption :: Maybe String + } + deriving (Show, Eq, Ord) diff --git a/tldr.cabal b/tldr.cabal index fd420d9..d29a53d 100644 --- a/tldr.cabal +++ b/tldr.cabal @@ -1,10 +1,10 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2. +-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack -- --- hash: 10ec649ff467c4fa6cedd898599125c78e4b7c56269fac74fe81112e0fec75f9 +-- hash: d3d3e0809356a76adc1e0a1bd557538b15e67f7e73377aaa2bf9dd91d3f831e9 name: tldr version: 0.7.1 @@ -42,6 +42,10 @@ flag static library exposed-modules: Tldr + Tldr.App + Tldr.App.Constant + Tldr.App.Handler + Tldr.Types other-modules: Paths_tldr hs-source-dirs: @@ -51,7 +55,13 @@ library , base >=4.7 && <5 , bytestring , cmark + , containers + , directory + , filepath + , optparse-applicative + , semigroups , text + , typed-process default-language: Haskell2010 executable tldr @@ -62,13 +72,7 @@ executable tldr app build-depends: base - , containers - , directory - , filepath - , optparse-applicative - , semigroups , tldr - , typed-process if flag(static) && os(linux) ghc-options: -rtsopts -threaded -optc-Os -optl=-pthread -optl=-static -fPIC ld-options: -static From e80e4b8cf8aeaba224e4361f0c5c66b0088c46fb Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Fri, 7 Aug 2020 23:24:26 +0530 Subject: [PATCH 2/5] More cleanup --- src/Tldr.hs | 4 ++-- src/Tldr/App.hs | 14 ++--------- src/Tldr/App/Handler.hs | 51 +++++++++++++++++++++++++++-------------- 3 files changed, 38 insertions(+), 31 deletions(-) diff --git a/src/Tldr.hs b/src/Tldr.hs index fe97d2b..baced37 100644 --- a/src/Tldr.hs +++ b/src/Tldr.hs @@ -14,11 +14,11 @@ module Tldr import CMark import Data.Monoid ((<>)) import Data.Text hiding (cons) -import qualified Data.Text as T -import qualified Data.Text.IO as TIO import GHC.IO.Handle (Handle) import System.Console.ANSI import Tldr.Types (ConsoleSetting(..)) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO defConsoleSetting :: ConsoleSetting defConsoleSetting = diff --git a/src/Tldr/App.hs b/src/Tldr/App.hs index 01cacc9..dca38bd 100644 --- a/src/Tldr/App.hs +++ b/src/Tldr/App.hs @@ -5,25 +5,16 @@ module Tldr.App ( appMain ) where -import Control.Monad import Data.List (intercalate) import Data.Semigroup ((<>)) -import Tldr.App.Constant import Data.Version (showVersion) -import System.IO (stdout, stderr, hPutStrLn) import Options.Applicative import Paths_tldr (version) -import System.Directory -import System.Environment (getArgs, lookupEnv) -import System.Exit (exitFailure) -import System.FilePath -import System.Process.Typed -import Data.Char (toLower) -import Tldr +import System.Environment (getArgs) +import Tldr.App.Constant (platformDirs) import Tldr.App.Handler import Tldr.Types - programOptions :: Parser TldrOpts programOptions = (TldrOpts <$> (updateIndexCommand <|> viewPageCommand <|> aboutFlag)) @@ -78,7 +69,6 @@ tldrParserInfo = (showVersion version) (long "version" <> short 'v' <> help "Show version") - appMain :: IO () appMain = do args <- getArgs diff --git a/src/Tldr/App/Handler.hs b/src/Tldr/App/Handler.hs index 11584fe..ebec42b 100644 --- a/src/Tldr/App/Handler.hs +++ b/src/Tldr/App/Handler.hs @@ -1,26 +1,43 @@ {-#LANGUAGE RecordWildCards#-} {-# LANGUAGE BangPatterns #-} -module Tldr.App.Handler where +module Tldr.App.Handler + ( handleAboutFlag + , retriveLocale + , checkLocale + , englishViewOptions + , getCheckDirs + , initializeTldrPages + , pageExists + , getPagePath + , updateTldrPages + , handleTldrOpts + ) where -import Data.Version (showVersion) +import Control.Monad (unless) +import Data.Char (toLower) +import Data.List (intercalate) +import Data.Semigroup ((<>)) import qualified Data.Set as Set +import Data.Version (showVersion) +import Options.Applicative import Paths_tldr (version) +import System.Directory + ( XdgDirectory(..) + , createDirectoryIfMissing + , doesDirectoryExist + , doesFileExist + , getXdgDirectory + ) import System.Environment (getExecutablePath) -import System.Directory (doesFileExist, XdgDirectory(..), getXdgDirectory, createDirectoryIfMissing, doesDirectoryExist) -import System.FilePath ((), (<.>)) +import System.Environment (lookupEnv) +import System.Exit (exitFailure) +import System.FilePath ((<.>), ()) +import System.IO (hPutStrLn, stderr, stdout) import System.Process.Typed -import Data.Semigroup ((<>)) -import Options.Applicative -import Data.List (intercalate) -import System.Environment (getArgs, lookupEnv) import Tldr -import Tldr.Types import Tldr.App.Constant -import Control.Monad (unless) -import Data.Char (toLower) -import System.Exit (exitFailure) -import System.IO (stdout, stderr, hPutStrLn) +import Tldr.Types handleAboutFlag :: IO () handleAboutFlag = do @@ -50,7 +67,7 @@ handleTldrOpts opts@TldrOpts {..} = do case tldrAction of UpdateIndex -> updateTldrPages About -> handleAboutFlag - vopts@(ViewPage voptions pages) -> do + ViewPage voptions pages -> do let npage = intercalate "-" pages locale <- case (languageOption voptions) of @@ -87,10 +104,10 @@ computeLocale lang = case map toLower <$> lang of Just ('e':'n':_) -> English Just (a:b:'_':_) -> Other (a:b:[]) Just (a:b:c:'_':_) -> Other (a:b:c:[]) - Just str -> Unknown str + Just other -> Unknown other getPagePath :: Locale -> String -> [String] -> IO (Maybe FilePath) -getPagePath locale page platformDirs = do +getPagePath locale page pDirs = do dataDir <- getXdgDirectory XdgData tldrDirName let currentLocale = case locale of English -> "pages" @@ -98,7 +115,7 @@ getPagePath locale page platformDirs = do Unknown xs -> "pages." <> xs Missing -> "pages" pageDir = dataDir "tldr" currentLocale - paths = map (\x -> pageDir x page <.> "md") platformDirs + paths = map (\x -> pageDir x page <.> "md") pDirs foldr1 (<|>) <$> mapM pageExists paths pageExists :: FilePath -> IO (Maybe FilePath) From 31c0881b2dea54558a1714f3569ebd7dce60185e Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Sat, 8 Aug 2020 18:19:09 +0530 Subject: [PATCH 3/5] Fix multiple line rendering bug More details https://github.com/psibi/tldr-hs/issues/26 --- src/Tldr.hs | 3 ++- test/data/grep.golden | 4 +++- test/data/ls.golden | 1 + test/data/ps.golden | 1 + 4 files changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Tldr.hs b/src/Tldr.hs index baced37..d9e3b27 100644 --- a/src/Tldr.hs +++ b/src/Tldr.hs @@ -45,7 +45,7 @@ toSGR cons = ] renderNode :: NodeType -> Handle -> IO () -renderNode (TEXT txt) handle = TIO.hPutStrLn handle txt +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 @@ -71,6 +71,7 @@ handleSubsetNodeType (CODE txt) = txt handleSubsetNodeType _ = mempty handleSubsetNode :: Node -> Text +handleSubsetNode (Node _ SOFTBREAK _) = "\n" handleSubsetNode (Node _ ntype xs) = handleSubsetNodeType ntype <> T.concat (Prelude.map handleSubsetNode xs) diff --git a/test/data/grep.golden b/test/data/grep.golden index 6bed5a6..06f36ff 100644 --- a/test/data/grep.golden +++ b/test/data/grep.golden @@ -1,5 +1,7 @@ grep -Matches patterns in input text.Supports simple patterns and regular expressions. + +Matches patterns in input text. +Supports simple patterns and regular expressions. - Search for an exact string: grep {{search_string}} {{path/to/file}} diff --git a/test/data/ls.golden b/test/data/ls.golden index e6d5b17..99792c3 100644 --- a/test/data/ls.golden +++ b/test/data/ls.golden @@ -1,4 +1,5 @@ ls + List directory contents. - List files one per line: diff --git a/test/data/ps.golden b/test/data/ps.golden index d120d53..569b6e7 100644 --- a/test/data/ps.golden +++ b/test/data/ps.golden @@ -1,4 +1,5 @@ ps + Information about running processes. - List all running processes: From f5589eda778246fa6d6d6c7568e5e56874516eb6 Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Sat, 8 Aug 2020 18:20:15 +0530 Subject: [PATCH 4/5] Update changelog --- CHANGELOG.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 53dcf78..8c61fd9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +# 0.8.0 + +* Split the library into more parts. +* Fix [multiple line bugs](https://github.com/psibi/tldr-hs/issues/26 "multiple line bugs") + # 0.7.1 * Client gives non zero exit status for non-existent pages. From b9f1fffb2e1be145b6e5cf6db49792ef1afb4bad Mon Sep 17 00:00:00 2001 From: Sibi Prabakaran Date: Sat, 8 Aug 2020 18:40:02 +0530 Subject: [PATCH 5/5] Fix hlint issues --- src/Tldr/App.hs | 10 +++++----- src/Tldr/App/Handler.hs | 26 ++++++++++++-------------- src/Tldr/Types.hs | 2 +- 3 files changed, 18 insertions(+), 20 deletions(-) diff --git a/src/Tldr/App.hs b/src/Tldr/App.hs index dca38bd..f92563b 100644 --- a/src/Tldr/App.hs +++ b/src/Tldr/App.hs @@ -1,5 +1,4 @@ {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE RecordWildCards #-} module Tldr.App ( appMain @@ -14,10 +13,11 @@ import System.Environment (getArgs) import Tldr.App.Constant (platformDirs) import Tldr.App.Handler import Tldr.Types +import Control.Monad (void) programOptions :: Parser TldrOpts programOptions = - (TldrOpts <$> (updateIndexCommand <|> viewPageCommand <|> aboutFlag)) + TldrOpts <$> (updateIndexCommand <|> viewPageCommand <|> aboutFlag) updateIndexCommand :: Parser TldrCommand updateIndexCommand = @@ -54,7 +54,7 @@ languageFlag = (strOption (long "language" <> short 'L' <> metavar "LOCALE" <> help - ("Preferred language for the page returned"))) + "Preferred language for the page returned")) tldrParserInfo :: ParserInfo TldrOpts tldrParserInfo = @@ -73,6 +73,6 @@ appMain :: IO () appMain = do args <- getArgs case execParserPure (prefs showHelpOnEmpty) tldrParserInfo args of - failOpts@(Failure _) -> handleParseResult failOpts >> return () + failOpts@(Failure _) -> void $ handleParseResult failOpts Success opts -> handleTldrOpts opts - compOpts@(CompletionInvoked _) -> handleParseResult compOpts >> return () + compOpts@(CompletionInvoked _) -> void $ handleParseResult compOpts diff --git a/src/Tldr/App/Handler.hs b/src/Tldr/App/Handler.hs index ebec42b..5d43303 100644 --- a/src/Tldr/App/Handler.hs +++ b/src/Tldr/App/Handler.hs @@ -29,8 +29,7 @@ import System.Directory , doesFileExist , getXdgDirectory ) -import System.Environment (getExecutablePath) -import System.Environment (lookupEnv) +import System.Environment (lookupEnv, getExecutablePath) import System.Exit (exitFailure) import System.FilePath ((<.>), ()) import System.IO (hPutStrLn, stderr, stdout) @@ -44,7 +43,7 @@ handleAboutFlag = do path <- getExecutablePath let content = unlines - [ path <> " v" <> (showVersion version) + [ path <> " v" <> showVersion version , "Copyright (C) 2017 Sibi Prabakaran" , "Source available at https://github.com/psibi/tldr-hs" ] @@ -63,23 +62,23 @@ englishViewOptions :: ViewOptions -> ViewOptions englishViewOptions xs = xs { languageOption = Just "en_US.utf8" } handleTldrOpts :: TldrOpts -> IO () -handleTldrOpts opts@TldrOpts {..} = do +handleTldrOpts opts@TldrOpts {..} = case tldrAction of UpdateIndex -> updateTldrPages About -> handleAboutFlag ViewPage voptions pages -> do let npage = intercalate "-" pages locale <- - case (languageOption voptions) of + case languageOption voptions of Nothing -> retriveLocale Just lg -> pure $ computeLocale (Just lg) fname <- getPagePath locale npage (getCheckDirs voptions) case fname of Just path -> renderPage path stdout - Nothing -> do + Nothing -> if checkLocale locale then do - hPutStrLn stderr ("No tldr entry for " <> (intercalate " " pages)) + hPutStrLn stderr ("No tldr entry for " <> unwords pages) exitFailure else handleTldrOpts (opts @@ -92,18 +91,17 @@ updateTldrPages = do dataDir <- getXdgDirectory XdgData tldrDirName let repoDir = dataDir "tldr" repoExists <- doesDirectoryExist repoDir - case repoExists of - True -> - runProcess_ $ - setWorkingDir (repoDir) $ proc "git" ["pull", "origin", "master"] - False -> initializeTldrPages + if repoExists + then runProcess_ $ + setWorkingDir repoDir $ proc "git" ["pull", "origin", "master"] + else initializeTldrPages computeLocale :: Maybe String -> Locale computeLocale lang = case map toLower <$> lang of Nothing -> Missing Just ('e':'n':_) -> English - Just (a:b:'_':_) -> Other (a:b:[]) - Just (a:b:c:'_':_) -> Other (a:b:c:[]) + Just (a:b:'_':_) -> Other [a,b] + Just (a:b:c:'_':_) -> Other [a,b,c] Just other -> Unknown other getPagePath :: Locale -> String -> [String] -> IO (Maybe FilePath) diff --git a/src/Tldr/Types.hs b/src/Tldr/Types.hs index 1a9095b..e0d0d42 100644 --- a/src/Tldr/Types.hs +++ b/src/Tldr/Types.hs @@ -15,7 +15,7 @@ data ConsoleSetting = , consoleIntensity :: ConsoleIntensity } -data TldrOpts = TldrOpts +newtype TldrOpts = TldrOpts { tldrAction :: TldrCommand } deriving (Show)