cless (empty) → 0.1.0.0

raw patch · 4 files changed

+153/−0 lines, 4 filesdep +basedep +highlighting-katedep +optparse-applicativesetup-changed

Dependencies added: base, highlighting-kate, optparse-applicative, terminfo, wl-pprint-extras, wl-pprint-terminfo

Files

LICENSE +20/−0
Setup.hs +2/−0
cless.cabal +30/−0
src/Main.hs +101/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2015 Hideyuki Tanaka++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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ cless.cabal view

@@ -0,0 +1,30 @@+name:                cless+version:             0.1.0.0+synopsis:            Colorized LESS+description:         Print file contents with syntax highlighting+homepage:            https://github.com/tanakh/cless+license:             MIT+license-file:        LICENSE+author:              Hideyuki Tanaka+maintainer:          tanaka.hideyuki@gmail.com+copyright:           (c) 2015 Hideyuki Tanaka+category:            Text+build-type:          Simple+cabal-version:       >=1.10++source-repository head+  type:                git+  location:            https://github.com/tanakh/cless.git++executable cless+  main-is:             Main.hs++  build-depends:       base >=4.7 && <4.8+                     , highlighting-kate >=0.5+                     , wl-pprint-terminfo >=3.7+                     , wl-pprint-extras+                     , terminfo+                     , optparse-applicative >=0.11++  hs-source-dirs:      src+  default-language:    Haskell2010

+ src/Main.hs view

@@ -0,0 +1,101 @@+{-# LANGUAGE RecordWildCards #-}++module Main (main) where++import           Control.Monad+import           Data.Maybe+import           Data.Monoid+import           Data.String+import           Options.Applicative+import           System.Console.Terminfo.Color       as Terminfo+import           System.Console.Terminfo.PrettyPrint+import           Text.Highlighting.Kate              as Kate+import           Text.PrettyPrint.Free               (hcat, vcat)++main :: IO ()+main = join $ execParser opts where+  opts = info (helper <*> cmd)+         ( fullDesc+        <> progDesc "Print the content of FILE with syntax highlighting"+        <> header "cless: Colorized LESS" )++  cmd = process+        <$> switch ( long "list-langs"+                  <> short 'L'+                  <> help "Show the list of supported languages" )+        <*> switch ( long "list-styles"+                  <> short 'S'+                  <> help "Show the list of supported styles" )+        <*> optional (strOption ( long "lang"+                  <> short 'l'+                  <> metavar "LANG"+                  <> help "Specify language name" ) )+        <*> optional (strOption ( long "style"+                  <> short 's'+                  <> metavar "STYLE"+                  <> help "Specify style name (default 'pygments')" ) )+        <*> argument str (metavar "FILE")++styles :: [(String, Style)]+styles =+  [ ("pygments"  , pygments  )+  , ("kate"      , kate      )+  , ("espresso"  , espresso  )+  , ("tango"     , tango     )+  , ("haddock"   , haddock   )+  , ("monochrome", monochrome)+  , ("zenburn"   , zenburn   )+  ]++process :: Bool -> Bool -> Maybe String -> Maybe String -> FilePath -> IO ()+process True _ _ _ _ =+  mapM_ putStrLn languages++process _ True _ _ _ =+  mapM_ (putStrLn . fst) styles++process _ _ mb_lang mb_stylename file = do+  con <- readFile file++  let lang = fromMaybe (error "cannot determin language")+             $ mb_lang <|> listToMaybe (languagesByFilename file)++      ss = highlightAs lang con++      style = maybe pygments findStyle mb_stylename++      findStyle name =+        fromMaybe (error $ "invalid style name: " ++ name)+        $ lookup name styles++  displayLn $ ppr style ss++ppr :: Style -> [SourceLine] -> TermDoc+ppr Style{..} = vcat . map (hcat . map token) where+  token (tokenType, ss) =+    tokenEffect tokenType $ fromString ss++  tokenEffect :: TokenType -> TermDoc -> TermDoc+  tokenEffect tokenType =+    let tokenStyle = fromMaybe defs $ lookup tokenType tokenStyles+        defs = defStyle { tokenColor = defaultColor+                        , tokenBackground = Nothing -- backgroundColor+                        }+    in styleToEffect tokenStyle++  styleToEffect TokenStyle{..} =+    with (maybe Nop (Foreground . cnvColor) tokenColor) .+    with (maybe Nop (Background . cnvColor) tokenBackground) .+    with (if tokenBold      then Bold      else Nop) .+    -- with (if tokenItalic    then Standout  else Nop) .+    with (if tokenUnderline then Underline else Nop)++cnvColor :: Kate.Color -> Terminfo.Color+cnvColor (RGB r g b) = ColorNumber+  $ 16+  + lucol (fromIntegral r) * 6 * 6+  + lucol (fromIntegral g) * 6+  + lucol (fromIntegral b)+  where+    tbl = [0x00, 0x5f, 0x87, 0xaf, 0xd7, 0xff :: Int]+    lucol v = snd $ minimum [ (abs $ a - v, i) | (a, i) <- zip tbl [0..] ]