diff --git a/lit.cabal b/lit.cabal --- a/lit.cabal +++ b/lit.cabal @@ -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.*, diff --git a/src/Parse.hs b/src/Parse.hs --- a/src/Parse.hs +++ b/src/Parse.hs @@ -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 -> "" diff --git a/src/Poll.hs b/src/Poll.hs --- a/src/Poll.hs +++ b/src/Poll.hs @@ -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 diff --git a/src/Pretty.hs b/src/Pretty.hs --- a/src/Pretty.hs +++ b/src/Pretty.hs @@ -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 diff --git a/src/Processing.hs b/src/Processing.hs --- a/src/Processing.hs +++ b/src/Processing.hs @@ -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"