diff --git a/CHANGELOG.md b/CHANGELOG.md index 453f7f2..5e0cc2d 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +# 0.6.0 + +* Make it obey --platform option +* Add -u as an alias for --update + + # 0.5.1 * Proper options handling diff --git a/app/Main.hs b/app/Main.hs index f9f73e0..8ecfad1 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,26 +1,58 @@ {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE RecordWildCards #-} -module Main where +module Main + ( main + ) where import Control.Monad -import Data.List (intercalate, isPrefixOf) +import Data.List (intercalate) import Data.Semigroup ((<>)) import Data.Version (showVersion) import GHC.IO.Handle.FD (stdout) -import Options.Applicative hiding ((<>)) +import Options.Applicative import Paths_tldr (version) import System.Directory -import System.Environment (getArgs, withArgs) +import System.Environment (getArgs) import System.FilePath import System.Process.Typed import Tldr data TldrOpts = TldrOpts - { pageName :: String + { tldrAction :: TldrCommand } deriving (Show) +data TldrCommand + = UpdateIndex + | ViewPage ViewOptions [String] + deriving (Show, Eq, Ord) + +data ViewOptions = + ViewOptions + { platformOption :: Maybe String + } + deriving (Show, Eq, Ord) + +programOptions :: Parser TldrOpts +programOptions = (TldrOpts <$> (updateIndexCommand <|> viewPageCommand)) + +updateIndexCommand :: Parser TldrCommand +updateIndexCommand = flag' UpdateIndex (long "update" <> short 'u') + +viewOptionsParser :: Parser ViewOptions +viewOptionsParser = ViewOptions <$> platformFlag + +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")) + tldrDirName :: String tldrDirName = "tldr" @@ -57,13 +89,10 @@ updateTldrPages = do setWorkingDir (repoDir) $ proc "git" ["pull", "origin", "master"] False -> initializeTldrPages -updateOption :: Parser (a -> a) -updateOption = infoOption "update" (long "update" <> help "Update tldr pages") - tldrParserInfo :: ParserInfo TldrOpts tldrParserInfo = info - (helper <*> versionOption <*> updateOption <*> programOptions) + (helper <*> versionOption <*> programOptions) (fullDesc <> progDesc "tldr Client program" <> header "tldr - Simplified and community-driven man pages") where @@ -73,10 +102,6 @@ tldrParserInfo = (showVersion version) (long "version" <> short 'v' <> help "Show version") -programOptions :: Parser TldrOpts -programOptions = - (TldrOpts <$> strArgument (metavar "COMMAND" <> help "name of the command")) - pageExists :: FilePath -> IO (Maybe FilePath) pageExists fname = do exists <- doesFileExist fname @@ -84,41 +109,34 @@ pageExists fname = do then return $ Just fname else return Nothing -getPagePath :: String -> IO (Maybe FilePath) -getPagePath page = do +getPagePath :: String -> [String] -> IO (Maybe FilePath) +getPagePath page platformDirs = do dataDir <- getXdgDirectory XdgData tldrDirName let pageDir = dataDir "tldr" "pages" - paths = map (\x -> pageDir x page <.> "md") checkDirs + paths = map (\x -> pageDir x page <.> "md") platformDirs foldr1 (<|>) <$> mapM pageExists paths -isOption :: String -> Bool -isOption string = "--" `isPrefixOf` string - -hasOption :: [String] -> Bool -hasOption xs = any isOption xs +getCheckDirs :: ViewOptions -> [String] +getCheckDirs voptions = + case platformOption voptions of + Nothing -> checkDirs + Just platform -> ["common", platform] + +handleTldrOpts :: TldrOpts -> IO () +handleTldrOpts TldrOpts {..} = do + case tldrAction of + UpdateIndex -> updateTldrPages + ViewPage voptions pages -> do + let npage = intercalate "-" pages + fname <- getPagePath npage (getCheckDirs voptions) + case fname of + Just path -> renderPage path stdout + Nothing -> putStrLn ("No tldr entry for " <> (intercalate " " pages)) main :: IO () main = do args <- getArgs case execParserPure (prefs showHelpOnEmpty) tldrParserInfo args of - failOpts@(Failure _) - | args == ["--update"] -> updateTldrPages - | otherwise -> - if (hasOption args || args == []) - then handleParseResult failOpts >> return () - else do - let npage = intercalate "-" args - fname <- getPagePath npage - case fname of - Just path -> renderPage path stdout - Nothing -> - putStrLn ("No tldr entry for " <> (intercalate " " args)) - Success opts -> do - initializeTldrPages - let page = pageName opts - fname <- getPagePath page - maybe - (putStrLn ("No tldr entry for " <> page)) - (flip renderPage stdout) - fname + failOpts@(Failure _) -> handleParseResult failOpts >> return () + Success opts -> handleTldrOpts opts compOpts@(CompletionInvoked _) -> handleParseResult compOpts >> return () diff --git a/src/Tldr.hs b/src/Tldr.hs index 24cdc13..12638c9 100644 --- a/src/Tldr.hs +++ b/src/Tldr.hs @@ -11,41 +11,39 @@ module Tldr , changeConsoleSetting ) where -import Data.Text -import qualified Data.Text as T -import qualified Data.Text.IO as TIO import CMark -import System.Console.ANSI 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 -data ConsoleSetting = ConsoleSetting - { italic :: Bool - , underline :: Underlining - , blink :: BlinkSpeed - , fgIntensity :: ColorIntensity - , fgColor :: Color - , bgIntensity :: ColorIntensity - , consoleIntensity :: ConsoleIntensity - } +data ConsoleSetting = + ConsoleSetting + { italic :: Bool + , underline :: Underlining + , blink :: BlinkSpeed + , fgIntensity :: ColorIntensity + , fgColor :: Color + , bgIntensity :: ColorIntensity + , consoleIntensity :: ConsoleIntensity + } defConsoleSetting :: ConsoleSetting defConsoleSetting = ConsoleSetting - { italic = False - , underline = NoUnderline - , blink = NoBlink - , fgIntensity = Dull - , fgColor = White - , bgIntensity = Dull - , consoleIntensity = NormalIntensity - } + { italic = False + , underline = NoUnderline + , blink = NoBlink + , fgIntensity = Dull + , fgColor = White + , bgIntensity = Dull + , consoleIntensity = NormalIntensity + } headingSetting :: ConsoleSetting -headingSetting = - defConsoleSetting - { consoleIntensity = BoldIntensity - } +headingSetting = defConsoleSetting {consoleIntensity = BoldIntensity} toSGR :: ConsoleSetting -> [SGR] toSGR cons = @@ -57,30 +55,21 @@ toSGR cons = ] renderNode :: NodeType -> Handle -> IO () -renderNode (TEXT txt) handle = TIO.hPutStrLn handle txt -renderNode (HTML_BLOCK txt) handle = TIO.hPutStrLn handle txt +renderNode (TEXT txt) handle = TIO.hPutStrLn handle txt +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 () +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 () changeConsoleSetting :: NodeType -> IO () changeConsoleSetting (HEADING _) = setSGR $ toSGR headingSetting changeConsoleSetting BLOCK_QUOTE = setSGR $ toSGR headingSetting -changeConsoleSetting ITEM = - setSGR $ - toSGR $ - defConsoleSetting - { fgColor = Green - } +changeConsoleSetting ITEM = setSGR $ toSGR $ defConsoleSetting {fgColor = Green} changeConsoleSetting (CODE _) = - setSGR $ - toSGR $ - defConsoleSetting - { fgColor = Yellow - } + setSGR $ toSGR $ defConsoleSetting {fgColor = Yellow} changeConsoleSetting _ = return () handleSubsetNodeType :: NodeType -> Text @@ -91,21 +80,25 @@ handleSubsetNodeType (HTML_INLINE txt) = txt handleSubsetNodeType (CODE txt) = txt handleSubsetNodeType _ = mempty - handleSubsetNode :: Node -> Text -handleSubsetNode (Node _ ntype xs) = handleSubsetNodeType ntype <> T.concat (Prelude.map handleSubsetNode xs) +handleSubsetNode (Node _ ntype xs) = + handleSubsetNodeType ntype <> T.concat (Prelude.map handleSubsetNode xs) handleParagraph :: [Node] -> Handle -> IO () -handleParagraph xs handle = TIO.hPutStrLn handle $ T.concat $ Prelude.map handleSubsetNode xs - +handleParagraph xs handle = + TIO.hPutStrLn handle $ T.concat $ Prelude.map handleSubsetNode xs handleNode :: Node -> Handle -> IO () handleNode (Node _ PARAGRAPH xs) handle = handleParagraph xs handle -handleNode (Node _ ITEM xs) handle = changeConsoleSetting ITEM >> handleParagraph xs handle +handleNode (Node _ ITEM xs) handle = + changeConsoleSetting ITEM >> handleParagraph xs handle handleNode (Node _ ntype xs) handle = do changeConsoleSetting ntype renderNode ntype handle - mapM_ (\(Node _ ntype' ns) -> renderNode ntype' handle >> mapM_ (`handleNode` handle) ns) xs + mapM_ + (\(Node _ ntype' ns) -> + renderNode ntype' handle >> mapM_ (`handleNode` handle) ns) + xs setSGR [Reset] parsePage :: FilePath -> IO Node diff --git a/tldr.cabal b/tldr.cabal index 1075615..cbbe7d2 100644 --- a/tldr.cabal +++ b/tldr.cabal @@ -1,7 +1,8 @@ name: tldr version: 0.5.1 synopsis: Haskell tldr client -description: Haskell tldr client with support for updating and viewing tldr pages. +description: Haskell tldr client with support for viewing tldr pages. Has offline + cache for accessing pages. homepage: https://github.com/psibi/tldr-hs#readme license: BSD3 license-file: LICENSE