commonmark-cli (empty) → 0.1.0.0
raw patch · 5 files changed
+354/−0 lines, 5 filesdep +aesondep +ansi-terminaldep +base
Dependencies added: aeson, ansi-terminal, base, bytestring, commonmark, commonmark-extensions, commonmark-pandoc, containers, mtl, pandoc-types, pretty-simple, text
Files
- LICENSE +30/−0
- README.md +5/−0
- changelog.md +3/−0
- commonmark-cli.cabal +46/−0
- src/convert.hs +270/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,5 @@+# commonmark-cli++A command-line tool for converting and syntax-highlighting+commonmark documents. See the output of+`commonmark-cli --help` for basic usage.
+ changelog.md view
@@ -0,0 +1,3 @@+# Changelog for commonmark-cli++## Unreleased changes
+ commonmark-cli.cabal view
@@ -0,0 +1,46 @@+name: commonmark-cli+version: 0.1.0.0+synopsis: Command-line commonmark converter and highlighter.+description: This package provides a command-line tool, `commonmark`,+ for converting and syntax-highlighting commonmark documents.+category: Text+homepage: https://github.com/jgm/commonmark-hs+bug-reports: https://github.com/jgm/commonmark-hs/issues+author: John MacFarlane+maintainer: jgm@berkeley.edu+copyright: 2018-2020 John MacFarlane+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++extra-source-files:+ changelog.md+ README.md++source-repository head+ type: git+ location: https://github.com/jgm/commonmark-hs++executable commonmark+ main-is: convert.hs+ hs-source-dirs: src+ if impl(ghc >= 8.8)+ ghc-options: -fwrite-ide-info -hiedir=.hie+ ghc-options: -threaded -rtsopts+ build-depends: base >=4.7 && <5+ , commonmark >= 0.1 && < 0.2+ , commonmark-extensions >= 0.1 && < 0.2+ , commonmark-pandoc >= 0.1 && < 0.2+ , pandoc-types+ , aeson+ , bytestring+ , containers+ , pretty-simple+ , mtl+ , bytestring+ , text+ , ansi-terminal+ other-modules:+ Paths_commonmark_cli+ default-language: Haskell2010
+ src/convert.hs view
@@ -0,0 +1,270 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Main where++import Commonmark+import Commonmark.Extensions+import Commonmark.Pandoc+import Data.Maybe (isJust)+import Data.Aeson (encode)+import qualified Data.Sequence as Seq+import qualified Data.ByteString.Lazy as BL+import qualified Text.Pandoc.Builder as B+import Control.Monad+import Control.Monad.Identity+import Control.Monad.State+import Data.Typeable+import qualified Data.Text.IO as TIO+import qualified Data.Text.Lazy.IO as TLIO+import qualified Data.Map as M+import qualified Data.Text as T+import System.Environment+import System.Exit+import System.IO+import System.Console.GetOpt+import Paths_commonmark_cli (version)+import Data.Version (showVersion)+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid+#endif+import Control.Exception (AsyncException, catch, throwIO)+import GHC.Stack (currentCallStack)+import System.Console.ANSI++data Opt =+ Help+ | Version+ | Tokenize+ | SourcePos+ | Highlight+ | PandocJSON+ | ListExtensions+ | Extension String+ deriving Eq++options :: [OptDescr Opt]+options =+ [ Option ['t'] ["tokenize"] (NoArg Tokenize) "tokenize"+ , Option ['x'] ["extension"] (ReqArg Extension "extension") "use extension"+ , Option ['p'] ["sourcepos"] (NoArg SourcePos) "source positions"+ , Option [] ["highlight"] (NoArg Highlight) "highlight using ANSI"+ , Option ['j'] ["json"] (NoArg PandocJSON) "pandoc JSON output"+ , Option ['v'] ["version"] (NoArg Version) "version info"+ , Option [] ["list-extensions"] (NoArg ListExtensions) "list extensions"+ , Option ['h'] ["help"] (NoArg Help) "help message"+ ]++usageMessage :: String -> [OptDescr Opt] -> String+usageMessage programName = usageInfo (programName ++ " [OPTIONS] [FILES]")++main :: IO ()+main = catch (do+ (opts, files, errs) <- getOpt Permute options <$> getArgs+ unless (null errs) $ do+ mapM_ (hPutStrLn stderr) errs+ exitWith (ExitFailure 1)+ prg <- getProgName+ when (Help `elem` opts) $ do+ putStr (usageMessage prg options)+ exitSuccess+ when (ListExtensions `elem` opts) $ do+ listExtensions+ exitSuccess+ when (Version `elem` opts) $ do+ putStrLn $ prg ++ " " ++ showVersion version+ exitSuccess+ toks <- if null files+ then tokenize "stdin" <$> TIO.getContents+ else mconcat <$> mapM (\f -> tokenize f <$> TIO.readFile f) files+ when (Tokenize `elem` opts) $ do+ print toks+ exitSuccess+ if Highlight `elem` opts then do+ spec <- specFromExtensionNames [x | Extension x <- opts]+ case runWithSourceMap <$>+ runIdentity (parseCommonmarkWith spec toks) of+ Left e -> errExit e+ Right (_ :: Html (), sm) -> highlightWith sm toks+ else+ if SourcePos `elem` opts then do+ spec <- specFromExtensionNames [x | Extension x <- opts]+ case runIdentity (parseCommonmarkWith spec toks) of+ Left e -> errExit e+ Right (r :: Html SourceRange)+ -> TLIO.putStr . renderHtml $ r+ else+ if PandocJSON `elem` opts then do+ spec <- specFromExtensionNames [x | Extension x <- opts]+ case runIdentity (parseCommonmarkWith spec toks) of+ Left e -> errExit e+ Right (r :: Cm () B.Blocks) -> do+ BL.putStr . encode $ B.doc $ unCm r+ BL.putStr "\n"+ else do+ spec <- specFromExtensionNames [x | Extension x <- opts]+ case runIdentity (parseCommonmarkWith spec toks) of+ Left e -> errExit e+ Right (r :: Html ()) -> TLIO.putStr . renderHtml $ r)+ (\(e :: AsyncException) -> do+ currentCallStack >>= mapM_ (hPutStrLn stderr)+ throwIO e)+++errExit :: ParseError -> IO a+errExit err = do+ hPrint stderr err+ exitWith (ExitFailure 1)++extensions :: (Monad m, Typeable m,+ Typeable bl, Typeable il,+ IsBlock il bl, IsInline il,+ HasPipeTable il bl,+ HasMath il,+ HasEmoji il,+ HasSpan il,+ ToPlainText il,+ HasStrikethrough il,+ HasSuperscript il,+ HasSubscript il,+ HasDefinitionList il bl,+ HasDiv bl,+ HasTaskList il bl,+ HasFootnote il bl)+ => [(String, SyntaxSpec m il bl)]+extensions =+ [ ("autolinks", autolinkSpec)+ ,("pipe_tables", pipeTableSpec)+ ,("hard_line_breaks", hardLineBreaksSpec)+ ,("strikethrough", strikethroughSpec)+ ,("superscript", superscriptSpec)+ ,("subscript", subscriptSpec)+ ,("smart", smartPunctuationSpec)+ ,("math", mathSpec)+ ,("emoji", emojiSpec)+ ,("footnotes", footnoteSpec)+ ,("definition_lists", definitionListSpec)+ ,("fancy_lists", fancyListSpec)+ ,("task_lists", taskListSpec)+ ,("attributes", attributesSpec)+ ,("raw_attribute", rawAttributeSpec)+ ,("bracketed_spans", bracketedSpanSpec)+ ,("fenced_divs", fencedDivSpec)+ ,("auto_identifiers", autoIdentifiersSpec)+ ,("auto_identifiers_ascii", autoIdentifiersAsciiSpec)+ ,("implicit_heading_references", implicitHeadingReferencesSpec)+ ,("gfm", gfmExtensions)+ ]++extensionList :: [String]+extensionList = map fst+ (extensions :: [(String, SyntaxSpec IO (Html ()) (Html ()))])++listExtensions :: IO ()+listExtensions =+ putStr $ "Available extensions (or 'all' for all):\n" +++ unlines (map (" " ++) extensionList)++specFromExtensionNames ::+ (Monad m, Typeable m, Typeable bl, Typeable il,+ IsBlock il bl, IsInline il,+ HasPipeTable il bl, HasMath il, HasEmoji il,+ HasSpan il,+ ToPlainText il,+ HasStrikethrough il,+ HasSuperscript il,+ HasSubscript il,+ HasDefinitionList il bl,+ HasDiv bl,+ HasTaskList il bl,+ HasFootnote il bl)+ => [String] -> IO (SyntaxSpec m il bl)+specFromExtensionNames extnames = do+ let extFromName name =+ case lookup name extensions of+ Just ext -> return ext+ Nothing -> do+ hPutStrLn stderr $ "Unknown extension " ++ name+ listExtensions+ exitWith (ExitFailure 1)+ exts <- if "all" `elem` extnames+ then return $ mconcat (map snd extensions)+ else mconcat <$> mapM extFromName extnames+ return $ exts <> defaultSyntaxSpec++highlightWith :: SourceMap -> [Tok] -> IO ()+highlightWith sm ts = evalStateT (mapM_ (hlTok sm) ts) (mempty, [])++hlTok :: SourceMap -> Tok+ -> StateT (Seq.Seq T.Text, [SGR]) IO ()+hlTok (SourceMap !sm) (Tok toktype !pos !t) = do+ (xs, sgrs) <- get+ -- When we encounter a line end, we store it in mbLineEnd+ -- and output it after the formatting codes at the beginning+ -- of the next line. Otherwise the wrong lines are affected.+ case M.lookup pos sm of+ Nothing -> liftIO $ do+ when (toktype == LineEnd) $+ -- This escape sequence paints rest of line with current+ -- background color; otherwise we get bad results with scrolling.+ TIO.putStr "\27[K"+ TIO.putStr t+ Just (starts, ends) -> do+ let xsMinusEnds = foldr (\e s ->+ case Seq.viewr s of+ Seq.EmptyR -> s+ z Seq.:> x+ | x == e -> z+ | otherwise -> s) xs (Seq.reverse ends)+ let xs' = xsMinusEnds <> starts+ let isStr = xs' `has` "str"+ let sgrs' = if xs == xs'+ then sgrs+ else Reset :+ SetConsoleIntensity+ (if isStr+ then NormalIntensity+ else FaintIntensity) :+ foldMap sgrFrom xs'+ put (xs', sgrs')+ liftIO $ do+ when (sgrs /= sgrs') $ setSGR sgrs'+ when (toktype == LineEnd) $+ TIO.putStr "\27[K"+ TIO.putStr t++sgrFrom :: T.Text -> [SGR]+sgrFrom t =+ case t of+ "link" -> [SetUnderlining SingleUnderline]+ "image" -> [SetColor Foreground Vivid Magenta]+ "entity" -> [SetColor Foreground Vivid Magenta]+ "escapedChar" -> [SetColor Foreground Vivid Magenta]+ "code" -> [SetColor Foreground Vivid White,+ SetColor Background Dull Cyan]+ "codeBlock" -> [SetColor Foreground Vivid White,+ SetColor Background Dull Cyan]+ "rawInline" -> [SetColor Foreground Vivid Green]+ "rawBlock" -> [SetColor Foreground Vivid Green]+ "heading1" -> [SetColor Foreground Vivid Blue]+ "heading2" -> [SetColor Foreground Vivid Blue]+ "heading3" -> [SetColor Foreground Vivid Blue]+ "heading4" -> [SetColor Foreground Vivid Blue]+ "heading5" -> [SetColor Foreground Vivid Blue]+ "heading6" -> [SetColor Foreground Vivid Blue]+ "blockQuote" -> [SetColor Foreground Dull Cyan]+ "referenceLinkDefinition"+ -> [SetColor Foreground Dull Cyan,+ SetUnderlining SingleUnderline]+ "emoji" -> [SetColor Foreground Vivid Magenta]+ "math" -> [SetColor Foreground Vivid Magenta]+ "strikethrough" -> [SetColor Foreground Vivid Magenta]+ "superscript" -> [SetColor Foreground Vivid Magenta]+ "subscript" -> [SetColor Foreground Vivid Magenta]+ "footnote" -> [SetColor Foreground Vivid Magenta]+ "footnoteRef" -> [SetColor Foreground Vivid Magenta]+ _ -> []++has :: Seq.Seq T.Text -> T.Text -> Bool+has xs t = isJust $ t `Seq.elemIndexL` xs