lhs2html 0.9999 → 0.99999

raw patch · 9 files changed

+62/−15 lines, 9 filesdep +Globdep +directory

Dependencies added: Glob, directory

Files

• data/footer.hs +0/−0
• data/footer.md +0/−0
• data/footer.txt +0/−0
• data/header.hs +0/−0
• data/header.htm +2/−1
• data/header.md +0/−0
• data/header.txt +0/−0
• lhs2html.cabal +3/−3
• src/lhs2html.hs +57/−11

@@ -11,7 +11,8 @@   p, ul, ol { margin: .5em 0; line-height: 1.4em }   code { border-radius: .4em; background: #eeeeee; padding: .2em; }   body { font-family: 'Helvetica', 'Arial', sans-serif }-  blockquote span { display: block }+  blockquote { white-space: pre }+  blockquote span { display: inline }   pre { background: #f0f0f0; border: 1px solid black; padding: 0.5em; }   pre span { counter-increment: theLines }   pre span:before { content: counter(theLines); position: absolute;                     display: block; text-align: right;                    margin-left: -3em; padding-right: 2em; margin-top: .2em;                    color: gray; font-size: .83em }

@@ -1,5 +1,5 @@ name:                lhs2html-version:             0.9999+version:             0.99999 synopsis:            Compile lhs in bird style to md, html, hs. license:             PublicDomain license-file:        LICENSE@@ -8,11 +8,11 @@ category:            Development build-type:          Simple cabal-version:       >=1.10-data-files:          data/*.htm+data-files:          data/*.htm, data/*.md, data/*.hs, data/*.txt  executable lhs2html   main-is:             lhs2html.hs-  build-depends:       base >=4.7 && <4.8, nicify, filepath+  build-depends:       base >=4.7 && <4.8, nicify, filepath, Glob, directory   hs-source-dirs:      src   default-language:    Haskell2010 

@@ -3,32 +3,77 @@ module Main where  import Data.Functor+import Data.List import Control.Monad import System.Environment import Text.Nicify-+import System.Directory import System.FilePath+import System.FilePath.Glob import Paths_lhs2html  main = getArgs >>= \case     -    [] -> lhs2html <$> getContents >>= putStrLn+    m : args+        | m == "-m" || m == "--markdown"  -> run lhs2md  "md"  args+        | m == "-u" || m == "--unlit"     -> run lhs2hs  "hs"  args+        | m == "-p" || m == "--parsetree" -> run lhs2txt "txt" args++        | m == "-v" || m == "--version"   -> putStrLn "lhs2html v0.99999"+        | m == "-h" || m == "--help"      -> putStrLn "\+            \  -m  --markdown  transform to github flavored markdown (*.md)\n\+            \  -u  --unlint    plain unlit to *.hs\n\+            \  -p  --parsetree show parse tree as *.txt\n\+            \  -h  --help      this help\n\+            \  -v  --version   show version information"++    args -> run lhs2html "htm" args++run processor suffix = \case++    [] -> processor <$> getContents >>= putStrLn          args -> do-        header <- getDataFileName ("data" </> "header.htm") >>= readFile-        footer <- getDataFileName ("data" </> "footer.htm") >>= readFile+        header <- getDataFileName ("data" </> "header" <.> suffix) >>= readFile+        footer <- getDataFileName ("data" </> "footer" <.> suffix) >>= readFile -        forM_ args $ \f -> do+        let process f = do+                isFile <- doesFileExist f+                isDir  <- doesDirectoryExist f -            let outfile = f ++ ".html"+                when isDir (globDir1 (compile "*.lhs") f >>= mapM_ process) -            writeFile outfile header-            lhs2html <$> readFile f >>= appendFile outfile-            appendFile outfile footer-    -lhs2html :: String -> String+                when isFile $ do+                    let outfile = f <.> suffix++                    writeFile outfile header+                    processor <$> readFile f >>= appendFile outfile+                    appendFile outfile footer+ +        mapM_ process args++lhs2txt = nicify . show . parse+ lhs2html = foldr toHTML "" . parse +lhs2md = concat . intersperse "\n" . filter (not . null) . map toMarkdown . parse+  where+    nl x y = x ++ '\n' : y+    infixr 5 `nl`++    toMarkdown = \case+        Code xs     -> unlines $ ("```haskell" : xs ++ ["```"])+        Para xs     -> unlines xs+        Quote xs    -> unlines xs+        OrdList xs  -> unlines $ map ("1. " ++) xs+        List xs     -> unlines $ map ("* "  ++) xs+        H1 x        -> x `nl` replicate (length x) '=' `nl` ""+        H2 x        -> x `nl` replicate (length x) '-' `nl` ""+        H3 x        -> "### " ++ x `nl` ""+        _ -> []++lhs2hs = unlines . concatMap (\case { Code xs -> xs; _ -> [] }) . parse+ parse :: String -> [Object] parse = process . map identify . lines @@ -50,6 +95,7 @@ identify = \case      '>' : ' ' : xs -> Code [xs]+    '>' : xs -> Code [xs]      '-' : xs       | all (== '-') xs -> H2'