packages feed

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 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