lit 0.1.0.3 → 0.1.0.4
raw patch · 5 files changed
+34/−55 lines, 5 filesdep +filepathdep −regex-compat
Dependencies added: filepath
Dependencies removed: regex-compat
Files
- lit.cabal +2/−2
- src/Parse.hs +0/−17
- src/Poll.hs +6/−6
- src/Pretty.hs +21/−11
- src/Processing.hs +5/−19
lit.cabal view
@@ -1,7 +1,7 @@ -- Initial lit.cabal generated by cabal init. For further documentation, name: lit-version: 0.1.0.3+version: 0.1.0.4 synopsis: A simple tool for literate programming description: lit has a minimal syntax for implementing literate programming. It generates both HTML and the native@@ -26,8 +26,8 @@ other-modules: Parse, Poll, Pretty, Processing, Types build-depends: base ==4.*, text ==1.1.*, - regex-compat ==0.95.*, parsec ==3.*, + filepath ==1.3.*, unordered-containers ==0.2.*, cheapskate ==0.1.*, blaze-markup ==0.6.*,
src/Parse.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} module Parse where -import Text.Regex import Text.Parsec import Text.Parsec.Text import qualified Data.Text as T@@ -32,10 +31,6 @@ chunk :: Parser Chunk chunk = (try def) <|> prose ---prose :: Parser Chunk---prose = do --- txts <- manyTill grabLine beginDef--- return $ Prose $ T.concat txts prose :: Parser Chunk prose = do txt <- packM =<< many (noneOf "\n\r")@@ -66,10 +61,6 @@ line <- grabLine return $ Code line --- Post: Consume newlines between a Code Chunk's last line and a Prose---endDef :: String -> Parser ()---endDef indent = try (skipMany newline >> (notFollowedBy (string indent) <|> ((lookAhead title) >> parserReturn ())))- endDef :: String -> Parser () endDef indent = try $ do { skipMany newline; notFollowedBy (string indent) <|> (lookAhead title >> parserReturn ()) } @@ -98,11 +89,3 @@ ws = char ' ' <|> char '\t' -- consume a whitespace char eol :: Parser Char eol = char '\n' <|> char '\r'--fileNameFromPath :: String -> String-fileNameFromPath path =- let r = mkRegex "(\\w+\\.\\w+)\\.lit$"- m = matchRegex r path - in case m of - Just (fst:rest) -> fst- Nothing -> ""
src/Poll.hs view
@@ -11,27 +11,27 @@ watch :: (String -> IO ()) -> [String] -> IO () watch fun fs = do putStrLn "starting.."+ mapM_ fun fs -- total microseconds for each file to cause a 1 sec delay per loop let delay = 1000000 `div` (length fs)- forever $ mapM_ (onDiff fun delay) fs+ forever $ (C.threadDelay 1000000 >> mapM_ (onDiff fun delay) fs) onDiff :: (String -> IO ()) -> Int -> String -> IO () onDiff fun delay file = do modified <- errorHandler (getModificationTime file) curTime <- getCurrentTime let diff = (diffUTCTime curTime modified)-- if diff < 1 then fun file >> C.threadDelay delay else return ()+ if diff < 2 then fun file >> C.threadDelay delay else return () -- a really conservative check to prevent file -- "inavailability" due to reading modification bits-errorHandler = errorHandlerNTimes 100+errorHandler = errorHandlerNTimes 10 errorHandlerNTimes 0 mnd = catchIOError mnd (\e -> ioError e)-errorHandlerNTimes times mnd = catchIOError mnd handle +errorHandlerNTimes times mnd = {-(putStrLn $ show times) >>-} catchIOError mnd handle where handle e = if isDoesNotExistError e - then C.threadDelay 5000 >> errorHandlerNTimes (times - 1) mnd+ then C.threadDelay 50000 >> errorHandlerNTimes (times - 1) mnd else ioError e
src/Pretty.hs view
@@ -11,7 +11,7 @@ import Cheapskate.Html import Text.Highlighting.Kate (defaultFormatOpts, highlightAs, languagesByFilename) import Text.Highlighting.Kate.Types -import Text.Blaze+import Text.Blaze (toValue, (!)) import qualified Text.Blaze.Html5 as H import qualified Text.Blaze.Html5.Attributes as A import Text.Blaze.Html.Renderer.Text (renderHtml)@@ -22,9 +22,9 @@ import Types -pretty :: String -> Maybe String -> [Chunk] -> T.Text-pretty lang maybeCss chunks = - TL.toStrict $ renderHtml $ preface maybeCss $ H.preEscapedToHtml $ map (chunkToHtml lang) chunks+pretty :: String -> Maybe String -> String -> [Chunk] -> T.Text+pretty lang maybeCss name chunks = + TL.toStrict $ renderHtml $ preface maybeCss name $ H.preEscapedToHtml $ map (chunkToHtml lang) chunks mark :: String -> [Chunk] -> T.Text mark lang chunks = T.concat $ map (chunkToMarkdown lang) chunks@@ -43,18 +43,28 @@ "\n" `T.append` mdParts `T.append` "```\n" -preface :: Maybe String -> H.Html -> H.Html-preface mCss rest = H.docTypeHtml $ do - let css = toValue $ fromMaybe "" mCss- H.head $ do- H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href css- H.body $ do rest+preface :: Maybe String -> String -> H.Html -> H.Html+preface maybeCss fileName bodyHtml =+ let + cssPath = fromMaybe "" maybeCss+ cssAttr = toValue cssPath+ includeCss = + if cssPath /= ""+ then H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href cssAttr+ else H.toHtml T.empty+ in + H.docTypeHtml $ do + H.head $ do+ H.title $ H.toHtml fileName+ H.meta ! A.charset "UTF-8" + includeCss+ H.body $ do bodyHtml chunkToHtml :: String -> Chunk -> H.Html chunkToHtml lang chunk = case chunk of- Prose txt -> toMarkup $ markdown def txt+ Prose txt -> H.toHtml $ markdown def txt Def _ name parts -> let header = headerToHtml name
src/Processing.hs view
@@ -3,11 +3,11 @@ ( build , htmlPipeline , mdPipeline-, codePipeline -, simplify ) where+, codePipeline ) where import Prelude hiding (readFile, writeFile) import Data.Text.IO (writeFile, readFile)+import System.FilePath.Posix (takeFileName, dropExtension) import Data.List (partition) import qualified Data.HashMap.Strict as Map@@ -18,14 +18,14 @@ import Types build mCss pipes file =- let fileName = fileNameFromPath file+ let fileName = dropExtension $ takeFileName file lang = getLang fileName in do stream <- readFile file encoded <- return $ encode stream mapM_ (\f -> f mCss lang fileName encoded) pipes >> return () -htmlPipeline = (\dir css lang path enc -> writeFile ((ensureTrailingSlash dir) ++ path ++ ".html") $ pretty lang css enc)+htmlPipeline = (\dir css lang path enc -> writeFile ((ensureTrailingSlash dir) ++ path ++ ".html") $ pretty lang css path enc) mdPipeline = (\dir css lang path enc -> writeFile ((ensureTrailingSlash dir) ++ path ++ ".md") $ (mark lang) enc) codePipeline = (\dir css lang path enc -> writeFile ((ensureTrailingSlash dir) ++ path) $ T.strip $ expand $ merge enc) @@ -46,20 +46,6 @@ in mergeAux (merged:ans) rem --- many consecutive Proses are reduced to a single Prose-simplify :: [Chunk] -> [Chunk]-simplify [] = []-simplify lst =- let (defs, ps) = span isDef lst- (ps', rest) = break isDef ps- in case ps' of- [] -> defs ++ rest- _ -> defs ++ [mergeProse ps'] ++ (simplify rest)--mergeProse :: [Chunk] -> Chunk-mergeProse lst = - Prose $ T.concat $ map getProseText lst- consecutive :: [Chunk] -> ([Chunk],[Chunk]) consecutive [] = ([],[]) consecutive lst@(fst:rest) =@@ -121,4 +107,4 @@ Ref name -> expandParts refParts partMap where refParts = Map.lookupDefault [] (T.strip name) partMap) in - T.concat (map toText parts)+ T.concat (map toText parts) `T.append` "\n"