Further improvments

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

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,52 +102,41 @@ 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
   if exists
     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 ()

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

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