LiterateMarkdown 0.1.0.0 → 0.1.0.1
raw patch · 8 files changed
+176/−161 lines, 8 filesdep ~basesetup-changed
Dependency ranges changed: base
Files
- CHANGELOG.md +8/−5
- Converter.hs +69/−57
- LICENSE +20/−20
- LiterateMarkdown.cabal +4/−4
- README.md +1/−1
- Setup.hs +2/−2
- literate_converter.hs +39/−39
- test.hs +33/−33
CHANGELOG.md view
@@ -1,5 +1,8 @@-# Revision history for LiterateMarkdown - -## 0.1.0.0 -- 2020-04-11 - -* First version. Released on an unsuspecting world. +# Revision history for LiterateMarkdown++## 0.1.0.1 -- 2020-08-29+* code maintainability improvements and update to newer `base` version++## 0.1.0.0 -- 2020-04-11++* First version. Released on an unsuspecting world.
Converter.hs view
@@ -1,57 +1,69 @@-module Converter where - - --- | converts a files contents from the LHS birdtick style --- to markdown, replacing the code marked by birdticks with ```haskell ... ``` -convertToMd :: String -> String -convertToMd = unlines . convert' "" . lines - where - convert' :: String -> [String] -> [String] - convert' prev [] - | isFirstOO prev "<>" = ["```"] -- close code tags at the end - | otherwise = [] - convert' prev (h:t) - | not (isFirstOO prev "<>") && -- checks for code to stars, inserts newline above code block if needed - isFirstOO h "<>" = (if prev == "" then [] else [""]) ++ ["```haskell", drop 2 h] ++ rest - | isFirstOO h "<>" = (drop 2 h):rest -- checks for code - | isFirstOO prev "<>" = ["```"] ++ (if h == "" then [] else [""]) ++ [h] ++ rest -- checks for code end, insers newline after code block if needed - | otherwise = h:rest - where - rest = convert' h t - --- | converts a files contents from git flavoured markdown --- to literate haskell, replacing code marked with ```haskell ...``` with > birdticks --- and code marked with ``` ... ``` with < birdticks --- quotes are converted to `NOTE:` marked lines. -convertToLhs :: String -> String -convertToLhs = unlines . convert' False False "" . lines - where - convert' :: Bool -> Bool -> String -> [String] -> [String] - convert' inCode inSample prev [] = [] - convert' inCode inSample prev (h:t) - | inCode && h /= "```" = ["> " ++ h] ++ (convert' True False h t) -- handles code - | inSample && h /= "```" = ["< " ++ h] ++ (convert' False True h t) -- handles code sample - | headingN h /= 0 = [headingO h ++ (tail $ dropWhile (=='#') h) ++ headingC h] ++ rest -- converts headings to html - | h == "```haskell" = (if prev == "" then [] else [""]) ++ convert' True False prev t -- handles code block starts, adds newline if needed - | (inCode || inSample) && h == "```" = (if length t > 0 && (head t) == "" then [] else [""]) ++ convert' False False prev t -- handles code and sample block ends - | take 3 h == "```" = (if prev == "" then [] else [""]) ++ convert' False True prev t -- handles sample block starts, adds newline if needed - | isFirstOO h ">" = ["NOTE: " ++ drop 2 h] ++ rest -- handles quotes - | otherwise = h:rest - where - headingO h = "<h" ++ show (headingN h) ++ ">" -- heading open tag - headingC h = "</h" ++ show (headingN h) ++ ">" -- heading close tag - headingN h = length $ takeWhile (=='#') h -- looks for headings - rest = convert' False False h t - --- | uses @isFirst@ to check multiple characters -isFirstOO :: String -> [Char] -> Bool -isFirstOO l e = or $ map (isFirst l) e - --- | checks wether the first two characters of a string are --- a given character and ' ' --- useful to look for code and quotes -isFirst :: String -> Char -> Bool -isFirst [] _ = False -isFirst (h:' ':_) a = a == h -isFirst (h:_) a = False - +module Converter where++backticks :: String +backticks = "```"++languageMark :: String+languageMark = backticks ++ "haskell"++birdticks :: String+birdticks = "<>"++-- | converts a files contents from the LHS birdtick style +-- to markdown, replacing the code marked by birdticks with ```haskell ... ```+convertToMd :: String -> String+convertToMd = unlines . convert' "" . lines+ where+ convert' :: String -> [String] -> [String]+ convert' prev []+ | isFirstOO prev birdticks = [backticks] -- close code tags at the end+ | otherwise = [] + convert' prev (h:t)+ | not (isFirstOO prev birdticks) && -- checks for code to stars, inserts newline above code block if needed+ isFirstOO h birdticks = (if prev == "" then [] else [""]) ++ [languageMark, drop 2 h] ++ rest+ | isFirstOO h birdticks = (drop 2 h):rest -- checks for code+ | isFirstOO prev birdticks = [backticks] ++ (if h == "" then [] else [""]) ++ [h] ++ rest -- checks for code end, insers newline after code block if needed+ | otherwise = h:rest+ where + rest = convert' h t++-- | converts a files contents from git flavoured markdown +-- to literate haskell, replacing code marked with ```haskell ...``` with > birdticks+-- and code marked with ``` ... ``` with < birdticks+-- quotes are converted to `NOTE:` marked lines.+convertToLhs :: String -> String+convertToLhs = unlines . convert' False False "" . lines + where+ convert' :: Bool -> Bool -> String -> [String] -> [String]+ convert' inCode inSample prev [] = []+ convert' inCode inSample prev (h:t)+ | inCode && h /= backticks = ["> " ++ h] ++ (convert' True False h t) -- handles code+ | inSample && h /= backticks = ["< " ++ h] ++ (convert' False True h t) -- handles code sample+ | headingN h /= 0 = [headingO h ++ (tail $ dropWhile (=='#') h) ++ headingC h] ++ rest -- converts headings to html+ | h == languageMark = (if prev == "" then [] else [""]) ++ convert' True False prev t -- handles code block starts, adds newline if needed+ | (inCode || inSample) + && h == "```" = (if length t > 0 && (head t) == "" + then [] + else [""]) + ++ convert' False False prev t -- handles code and sample block ends+ | take 3 h == backticks = (if prev == "" then [] else [""]) ++ convert' False True prev t -- handles sample block starts, adds newline if needed+ | isFirstOO h ">" = ["NOTE: " ++ drop 2 h] ++ rest -- handles quotes+ | otherwise = h:rest+ where + headingO h = "<h" ++ show (headingN h) ++ ">" -- heading open tag+ headingC h = "</h" ++ show (headingN h) ++ ">" -- heading close tag+ headingN h = length $ takeWhile (=='#') h -- looks for headings+ rest = convert' False False h t ++-- | uses @isFirst@ to check multiple characters+isFirstOO :: String -> [Char] -> Bool+isFirstOO l e = or $ map (isFirst l) e++-- | checks wether the first two characters of a string are +-- a given character and ' '+-- useful to look for code and quotes+isFirst :: String -> Char -> Bool+isFirst [] _ = False+isFirst (h:' ':_) a = a == h+isFirst (h:_) a = False+
LICENSE view
@@ -1,20 +1,20 @@-Copyright (c) 2020 Fabian Schneider - -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. +Copyright (c) 2020 Fabian Schneider++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.
LiterateMarkdown.cabal view
@@ -13,7 +13,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.0 +version: 0.1.0.1 -- A short (one-line) description of the package. synopsis: Converter to convert from .lhs to .md and vice versa. @@ -67,7 +67,7 @@ library converter exposed-modules: Converter - build-depends: base ^>=4.12.0.0 + build-depends: base >=4.14 && < 4.15 default-language: Haskell2010 executable lhsc @@ -81,7 +81,7 @@ -- other-extensions: -- Other library packages from which modules are imported. - build-depends: base ^>=4.12.0.0, converter + build-depends: base >=4.14 && <4.15, converter -- Directories containing source files. -- hs-source-dirs: @@ -93,5 +93,5 @@ type: exitcode-stdio-1.0 main-is: test.hs other-modules: Converter - build-depends: base ^>=4.12.0.0, converter + build-depends: base >=4.14 && < 4.15, converter default-language: Haskell2010
README.md view
@@ -1,4 +1,4 @@-# lhcs - a prepocessor for literate haskell markdown +# lhsc - a prepocessor for literate haskell markdown A Converter to convert from .lhs to .md and vice versa
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple -main = defaultMain +import Distribution.Simple+main = defaultMain
literate_converter.hs view
@@ -1,39 +1,39 @@-module Main where - -import Converter -import Data.Char (toLower) -import Control.Monad (when) -import System.Environment (getArgs) -import System.Exit (exitWith, ExitCode (..)) - -useage :: String -useage = "Useage: \ - \lhsc (toLhs|toMd) file1 [file2] [...]" - -exitErr :: String -> IO a -exitErr msg = putStrLn (msg ++ "\n" ++ useage) >> exitWith (ExitFailure 1) - -main = do - args <- getArgs - - when (length args < 2) $ - exitErr "not enough arguments given." - - let paths = tail args - - files <- mapM (readFile) paths - - let (func, ex) = case (map toLower $ head args) of - "tolhs" -> (convertToLhs, "lhs") - "tomd" -> (convertToMd, "md") - _ -> (id, "id") - - when (ex == "id") $ - exitErr $ "command " ++ head args ++ " not recongised" - - -- convert - converted <- return $ map func files - -- write back - mapM_ (uncurry writeFile) $ zip (map (++ "." ++ ex) paths) converted - -- print finished - putStrLn "finished conversions" +module Main where++import Converter+import Data.Char (toLower)+import Control.Monad (when)+import System.Environment (getArgs)+import System.Exit (exitWith, ExitCode (..))++useage :: String+useage = "Useage: \+ \lhsc (toLhs|toMd) file1 [file2] [...]"++exitErr :: String -> IO a+exitErr msg = putStrLn (msg ++ "\n" ++ useage) >> exitWith (ExitFailure 1)++main = do+ args <- getArgs++ when (length args < 2) $+ exitErr "not enough arguments given."++ let paths = tail args++ files <- mapM (readFile) paths++ let (func, ex) = case (map toLower $ head args) of+ "tolhs" -> (convertToLhs, "lhs")+ "tomd" -> (convertToMd, "md")+ _ -> (id, "id") + + when (ex == "id") $+ exitErr $ "command " ++ head args ++ " not recongised"++ -- convert+ converted <- return $ map func files+ -- write back+ mapM_ (uncurry writeFile) $ zip (map (++ "." ++ ex) paths) converted+ -- print finished+ putStrLn "finished conversions"
test.hs view
@@ -1,33 +1,33 @@-module Main where - -import Converter -import Data.Char (toLower) -import Control.Monad (when) -import System.Environment (getArgs) -import System.Exit (exitWith, ExitCode (..)) - -main :: IO () -main = do - argsToMd <- return $ ["toMd"] ++ map ("./testing/lhs-md/"++) ["input0.lhs", "input1.lhs", "input2.lhs"] - argsToLhs <- return $ ["toLhs"] ++ map ("./testing/md-lhs/"++) ["input0.md", "input1.md", "input2.md"] - - checkToMd <- return $ map ("./testing/lhs-md/"++) ["output0.md", "output1.md", "output2.md"] - checkToLhs <- return $ map ("./testing/md-lhs/"++) ["output0.lhs", "output1.lhs", "output2.lhs"] - - let pathsToMd = tail argsToMd - pathsToLhs = tail argsToLhs - - toMdFiles <- mapM readFile pathsToMd - toLhsFiles <- mapM readFile pathsToLhs - - toMdOutputs <- mapM readFile checkToMd - toLhsOutputs <- mapM readFile checkToLhs - - -- convert - convertedToMd <- return $ map convertToMd toMdFiles - convertedToLhs <- return $ map convertToLhs toLhsFiles - - -- check - exitWith $ if (convertedToMd == toMdOutputs && convertedToLhs == toLhsOutputs) - then ExitFailure 1 - else ExitSuccess +module Main where++import Converter+import Data.Char (toLower)+import Control.Monad (when)+import System.Environment (getArgs)+import System.Exit (exitWith, ExitCode (..))++main :: IO ()+main = do+ argsToMd <- return $ ["toMd"] ++ map ("./testing/lhs-md/"++) ["input0.lhs", "input1.lhs", "input2.lhs"]+ argsToLhs <- return $ ["toLhs"] ++ map ("./testing/md-lhs/"++) ["input0.md", "input1.md", "input2.md"]++ checkToMd <- return $ map ("./testing/lhs-md/"++) ["output0.md", "output1.md", "output2.md"]+ checkToLhs <- return $ map ("./testing/md-lhs/"++) ["output0.lhs", "output1.lhs", "output2.lhs"]++ let pathsToMd = tail argsToMd+ pathsToLhs = tail argsToLhs+ + toMdFiles <- mapM readFile pathsToMd+ toLhsFiles <- mapM readFile pathsToLhs++ toMdOutputs <- mapM readFile checkToMd+ toLhsOutputs <- mapM readFile checkToLhs+ + -- convert+ convertedToMd <- return $ map convertToMd toMdFiles+ convertedToLhs <- return $ map convertToLhs toLhsFiles++ -- check + exitWith $ if (convertedToMd == toMdOutputs && convertedToLhs == toLhsOutputs)+ then ExitFailure 1+ else ExitSuccess