mdcat 0.1.0.3 → 0.1.0.4

raw patch · 2 files changed

+110/−3 lines, 2 files

Files

• mdcat.cabal +10/−3
• src/Mdcat.hs +100/−0

@@ -2,7 +2,7 @@ --  see http://haskell.org/cabal/users-guide/  name:                mdcat-version:             0.1.0.3+version:             0.1.0.4 synopsis:            Markdown viewer in your terminal description:		 A simple command line tool for viewing markdown in your terminal -- description:         @@ -17,10 +17,17 @@ extra-source-files:  README.md cabal-version:       >=1.10 +library+  exposed-modules:     Mdcat+  default-language:    Haskell2010+  hs-source-dirs:      src+  build-depends:       base >=4.6 && <5.0, pandoc >=1.13 && <1.14, directory >=1.2 && <1.3, ansi-terminal >=0.6 && <0.7, terminfo >= 0.4.0.0++ executable mdcat   main-is:             Main.hs-  -- other-modules:       -  -- other-extensions:    +  -- other-modules:    Mdcat+  -- other-extensions:    build-depends:       base >=4.6 && <5.0, pandoc >=1.13 && <1.14, directory >=1.2 && <1.3, ansi-terminal >=0.6 && <0.7, terminfo >= 0.4.0.0   hs-source-dirs:      src   default-language:    Haskell2010

@@ -0,0 +1,100 @@+module Mdcat(+    render,+    debugMessage+  ) where++  import System.Environment (getArgs, lookupEnv)+  import Text.Pandoc+  import System.Directory+  import System.Console.ANSI+  import Control.Monad+  import System.Console.Terminfo.Base+  import System.Console.Terminfo.Cursor+  import Data.IORef+  import System.IO.Unsafe++  debug = 1000 -- set this to 1000 to disable all possible debug messages++  debugMessage level msg = when (level > debug) $ print msg++  colorStack :: IORef [SGR]+  {-# NOINLINE colorStack #-}+  colorStack = unsafePerformIO $ newIORef []++  pushtToColorStack :: SGR -> IO ()+  pushtToColorStack s = modifyIORef colorStack (s:)++  popFromColorStack :: IO (Maybe SGR)+  popFromColorStack = do+    cs <- readIORef colorStack+    case cs of+      [] -> return Nothing+      (s:ss) -> do+        modifyIORef colorStack (drop 1)+        return $ Just s++  alterColor :: SGR -> IO() -> IO ()+  alterColor s ios = do+    c <- popFromColorStack+    setSGR [s]+    pushtToColorStack s+    ios+    case c of+      Nothing -> setSGR []+      Just ns -> if ns == s then setSGR [] else setSGR [ns]++  duplicate :: Int -> String -> String+  duplicate n string = concat $ replicate n string++  renderInline :: Inline -> IO ()+  renderInline i = case i of+    Str i -> putStr i+    Space -> putStr " "+    Emph i -> do+      setSGR [SetItalicized True, SetConsoleIntensity BoldIntensity]+      renderInlines i+      setSGR [SetItalicized False, SetConsoleIntensity NormalIntensity]++    Link is t -> alterColor (SetColor Foreground Dull Green) ((\() -> do+      putStr "["+      renderInlines is+      putStr "]"+      putStr "("+      putStr $ fst t+      putStr ")") ())+    _ -> return ()++  renderInlines :: [Inline] -> IO ()+  renderInlines = mapM_ renderInline++  renderElement :: Block -> IO ()+  renderElement e = case e of+    Header level attr inline ->+      alterColor (SetColor Foreground Dull Red) ((\() -> do+        renderInlines inline+        putStrLn "") ())+    Para inline -> do+      renderInlines inline+      putStrLn ""+    Plain inline -> renderInlines inline+    HorizontalRule -> do+      t <- setupTermFromEnv+      let mc = getCapability t termColumns in case mc of+        Nothing -> putStrLn $ duplicate 80 "-"+        Just c -> putStrLn $ duplicate c "-"+      --debugMessage 1 $ getCapability t termColumns+    BulletList (b:bs) -> do+      putStr "  * "+      renderBlocks b+      putStrLn ""+      renderElement (BulletList bs)+    _ -> return ()++  renderBlocks :: [Block] -> IO ()+  renderBlocks = mapM_ renderElement++  render :: Pandoc -> IO ()+  render md = case md of+      Pandoc m b -> renderBlocks b >> do+        cs <- readIORef colorStack+        return ()