catnplus (empty) → 0.1.0.0
raw patch · 12 files changed
+355/−0 lines, 12 filesdep +ansi-terminaldep +basedep +directorysetup-changed
Dependencies added: ansi-terminal, base, directory, either, optparse-applicative, template-haskell, terminal-size, transformers, vcs-revision
Files
- LICENSE +20/−0
- README.md +16/−0
- Setup.hs +16/−0
- catnplus.cabal +44/−0
- src/CatNPlus.hs +19/−0
- src/CatNPlus/App.hs +61/−0
- src/CatNPlus/GetHiddenChar.hs +21/−0
- src/CatNPlus/GetHiddenChar/Posix.hs +36/−0
- src/CatNPlus/GetHiddenChar/Windows.hs +22/−0
- src/CatNPlus/KeyPress.hs +31/−0
- src/Main.hs +38/−0
- src/VersionInfo.hs +31/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2017 Richard Cook++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,16 @@+# catnplus++Simple tool to display text files with line numbers and paging++## Why?++'Cause Windows' [`type`][type-ss64] command leaves a lot to be desired++## Licence++[MIT License][licence]++Copyright © 2017, Richard Cook.++[licence]: LICENSE+[type-ss64]: https://ss64.com/nt/type.html
+ Setup.hs view
@@ -0,0 +1,16 @@+{-|+Module : Main+Description : Setup entrypoint for catnplus+Copyright : (C) Richard Cook, 2017+Licence : MIT+Maintainer : rcook@rcook.org+Stability : experimental+Portability : portable+-}++module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ catnplus.cabal view
@@ -0,0 +1,44 @@+name: catnplus+version: 0.1.0.0+synopsis: Simple tool to display text files with line numbers and paging+description: Simple tool to display text files with line numbers and paging+homepage: https://github.com/rcook/catnplus#readme+license: MIT+license-file: LICENSE+author: Richard Cook+maintainer: rcook@rcook.org+copyright: 2017 Richard Cook+category: Command Line Tool+build-type: Simple+cabal-version: >=1.10+extra-source-files: README.md++executable catnplus+ hs-source-dirs: src+ ghc-options: -W -Wall+ main-is: Main.hs+ default-language: Haskell2010+ other-modules: CatNPlus+ , CatNPlus.App+ , CatNPlus.GetHiddenChar+ , CatNPlus.KeyPress+ , VersionInfo+ if os(linux)+ cpp-options: -DOS_Linux+ other-modules: CatNPlus.GetHiddenChar.Posix+ if os(windows)+ cpp-options: -DOS_Windows+ other-modules: CatNPlus.GetHiddenChar.Windows+ if os(darwin)+ cpp-options: -DOS_macOS+ other-modules: CatNPlus.GetHiddenChar.Posix++ build-depends: ansi-terminal+ , base >= 4.7 && < 5+ , directory+ , either+ , optparse-applicative+ , template-haskell+ , terminal-size+ , transformers+ , vcs-revision
+ src/CatNPlus.hs view
@@ -0,0 +1,19 @@+{-|+Module : CatNPlus+Description : Umbrella module+Copyright : (C) Richard Cook, 2017+Licence : MIT+Maintainer : rcook@rcook.org+Stability : experimental+Portability : portable+-}++module CatNPlus+ ( module CatNPlus.App+ , module CatNPlus.GetHiddenChar+ , module CatNPlus.KeyPress+ ) where++import CatNPlus.App+import CatNPlus.GetHiddenChar+import CatNPlus.KeyPress
+ src/CatNPlus/App.hs view
@@ -0,0 +1,61 @@+{-|+Module : CatNPlus.App+Description : Application entrypoint for catnplus+Copyright : (C) Richard Cook, 2017+Licence : MIT+Maintainer : rcook@rcook.org+Stability : experimental+Portability : portable+-}++module CatNPlus.App (runApp) where++import CatNPlus.KeyPress+import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Monad.Trans.Either+import qualified System.Console.ANSI as ANSI+import qualified System.Console.Terminal.Size as TS+import System.Directory+import System.IO+import Text.Printf++withSGR :: [ANSI.SGR] -> IO a -> IO a+withSGR sgrs = bracket_+ (ANSI.setSGR sgrs)+ (ANSI.setSGR [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.White])++withSGRCond :: Bool -> [ANSI.SGR] -> IO a -> IO a+withSGRCond True sgrs action = withSGR sgrs action+withSGRCond False _ action = action++getPageLength :: IO Int+getPageLength = do+ mbWindow <- TS.size+ case mbWindow of+ Nothing -> return 20+ Just (TS.Window h _) -> return $ h - 2++runApp :: [FilePath] -> IO ()+runApp paths = do+ pageLength <- getPageLength+ isTerminal <- hIsTerminalDevice stdout+ void $ runEitherT $ forM_ paths $ \p -> do+ content <- liftIO $ do+ path <- canonicalizePath p+ withSGRCond isTerminal [ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.Green] $+ putStrLn path+ readFile path+ runEitherT $ forM_ (zip [1..] (lines content)) $ \(n, line) -> do+ liftIO $ do+ withSGRCond isTerminal [ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Yellow] $+ putStr (printf "%6d" n)+ putStrLn $ " " ++ line++ when (isTerminal && n `mod` pageLength == 0) $ do+ shouldContinue <- liftIO $ do+ c <- waitForKeyPressOneOf ['Q', 'q', ' ']+ return $ c /= 'Q' && c/= 'q'+ when (not shouldContinue) $ lift $ left ()
+ src/CatNPlus/GetHiddenChar.hs view
@@ -0,0 +1,21 @@+{-|+Module : CatNPlus+Description : Umbrella module for GetHiddenChar+Copyright : (C) Richard Cook, 2017+Licence : MIT+Maintainer : rcook@rcook.org+Stability : experimental+Portability : portable+-}++{-# LANGUAGE CPP #-}++module CatNPlus.GetHiddenChar (getHiddenChar) where++#if defined(OS_Linux) || defined(OS_macOS)+import CatNPlus.GetHiddenChar.Posix+#elif defined(OS_Windows)+import CatNPlus.GetHiddenChar.Windows+#else+#error Unsupported platform+#endif
+ src/CatNPlus/GetHiddenChar/Posix.hs view
@@ -0,0 +1,36 @@+{-|+Module : CatNPlus+Description : Posix implementation of GetHiddenChar+Copyright : (C) Richard Cook, 2017+Licence : MIT+Maintainer : rcook@rcook.org+Stability : experimental+Portability : portable+-}++module CatNPlus.GetHiddenChar.Posix (getHiddenChar) where++import Control.Exception+import System.IO++data HandleState = HandleState BufferMode Bool++hGetState :: Handle -> IO HandleState+hGetState h = do+ bufferMode <- hGetBuffering h+ isEcho <- hGetEcho h+ return $ HandleState bufferMode isEcho++hSetState :: Handle -> HandleState -> IO ()+hSetState h (HandleState mode isEcho) = do+ hSetEcho h isEcho+ hSetBuffering h mode++bracketHandle :: Handle -> (IO a -> IO a)+bracketHandle h action = bracket (hGetState h) (hSetState h) (const action)++getHiddenChar :: IO Char+getHiddenChar = bracketHandle stdin $ do+ hSetBuffering stdin NoBuffering+ hSetEcho stdin False+ getChar
+ src/CatNPlus/GetHiddenChar/Windows.hs view
@@ -0,0 +1,22 @@+{-|+Module : CatNPlus+Description : Windows implementation of GetHiddenChar+Copyright : (C) Richard Cook, 2017+Licence : MIT+Maintainer : rcook@rcook.org+Stability : experimental+Portability : portable+-}++{-# LANGUAGE ForeignFunctionInterface #-}++module CatNPlus.GetHiddenChar.Windows (getHiddenChar) where++import Data.Char+import Foreign.C.Types++foreign import ccall unsafe "conio.h getch" c_getch :: IO CInt++-- Hack based on http://stackoverflow.com/questions/2983974/haskell-read-input-character-from-console-immediately-not-after-newline+getHiddenChar :: IO Char+getHiddenChar = fmap (chr.fromEnum) c_getch
+ src/CatNPlus/KeyPress.hs view
@@ -0,0 +1,31 @@+{-|+Module : CatNPlus.KeyPress+Description : Key press detections+Copyright : (C) Richard Cook, 2017+Licence : MIT+Maintainer : rcook@rcook.org+Stability : experimental+Portability : portable+-}++module CatNPlus.KeyPress (waitForKeyPressOneOf) where++import CatNPlus.GetHiddenChar+import Control.Exception+import Control.Monad+import Control.Monad.Trans.Class+import Control.Monad.Trans.Either+import System.Console.ANSI+import System.IO++prompt :: String+prompt = ": "++waitForKeyPressOneOf :: [Char] -> IO Char+waitForKeyPressOneOf cs = bracket_+ (putStr prompt >> hFlush stdout)+ (cursorBackward (length prompt) >> clearFromCursorToLineEnd) $ do+ Left c <- runEitherT $ forever $ do+ c <- lift getHiddenChar+ when (c `elem` cs) (left c)+ return c
+ src/Main.hs view
@@ -0,0 +1,38 @@+{-|+Module : Main+Description : Main entrypoint for catnplus+Copyright : (C) Richard Cook, 2017+Licence : MIT+Maintainer : rcook@rcook.org+Stability : experimental+Portability : portable+-}++module Main (main) where++import CatNPlus+import Options.Applicative+import VersionInfo++data Command = ShowFiles [FilePath] | ShowVersion++productVersion :: String+productVersion = "catnplus " ++ fullVersionString++commandParser :: Parser Command+commandParser = filePathsParser <|> versionParser++filePathsParser :: Parser Command+filePathsParser = ShowFiles <$> some (argument str (metavar "FILES..."))++versionParser :: Parser Command+versionParser = flag' ShowVersion (short 'v' <> long "version" <> help "Show version")++main :: IO ()+main = parseOptions >>= runCommand+ where+ parseOptions = execParser $ info+ (helper <*> commandParser)+ (fullDesc <> progDesc "Display text files with line numbers" <> header productVersion)+ runCommand (ShowFiles paths) = runApp paths+ runCommand ShowVersion = putStrLn productVersion
+ src/VersionInfo.hs view
@@ -0,0 +1,31 @@+{-|+Module : VersionInfo+Description : Version information for catnplus+Copyright : (C) Richard Cook, 2017+Licence : MIT+Maintainer : rcook@rcook.org+Stability : experimental+Portability : portable+-}++{-# LANGUAGE TemplateHaskell #-}++module VersionInfo (fullVersionString) where++import Data.Version+import Distribution.VcsRevision.Git+import Language.Haskell.TH.Syntax+import Paths_catnplus++gitVersionString :: String+gitVersionString = $(do+ v <- qRunIO getRevision+ lift $ case v of+ Nothing -> []+ Just (commit, True) -> commit ++ " (locally modified)"+ Just (commit, False) -> commit)++fullVersionString :: String+fullVersionString = case gitVersionString of+ [] -> showVersion version+ v -> showVersion version ++ "." ++ v