lit 0.1.0.4 → 0.1.0.5
raw patch · 12 files changed
+405/−319 lines, 12 filesdep ~text
Dependency ranges changed: text
Files
- lit.cabal +3/−3
- src/Code.hs +54/−0
- src/Highlight.hs +56/−0
- src/Html.hs +92/−0
- src/Markdown.hs +40/−0
- src/Parse.hs +39/−44
- src/Poll.hs +19/−20
- src/Pretty.hs +0/−132
- src/Process.hs +71/−0
- src/Processing.hs +0/−110
- src/Types.hs +23/−0
- src/lit.hs +8/−10
lit.cabal view
@@ -1,7 +1,7 @@ -- Initial lit.cabal generated by cabal init. For further documentation, name: lit-version: 0.1.0.4+version: 0.1.0.5 synopsis: A simple tool for literate programming description: lit has a minimal syntax for implementing literate programming. It generates both HTML and the native@@ -23,9 +23,9 @@ executable lit main-is: lit.hs hs-source-dirs: src- other-modules: Parse, Poll, Pretty, Processing, Types+ other-modules: Parse, Poll, Process, Code, Html, Markdown, Highlight, Types build-depends: base ==4.*,- text ==1.1.*, + text >= 1 && < 2, parsec ==3.*, filepath ==1.3.*, unordered-containers ==0.2.*,
+ src/Code.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE OverloadedStrings #-}+module Code ( generate ) where++import Data.List (partition)+import qualified Data.HashMap.Strict as Map+import qualified Data.Text as T++import Types++generate :: [Chunk] -> T.Text+generate = expand . merge . (filter isDef)++merge :: [Chunk] -> [Chunk]+merge = mergeAux []+mergeAux ans [] = ans+mergeAux ans (next:rest) = + let + name = getName next+ chunkHasName name = (== name) . getName+ (found, rem) = partition (chunkHasName name) rest + merged = combineChunks (next:found)+ in + mergeAux (merged:ans) rem++combineChunks :: [Chunk] -> Chunk+combineChunks (a:[]) = a+combineChunks l@(c:cs) = Def line name parts + where+ parts = concatMap getParts l+ name = getName c+ line = getLineNo c++expand :: [Chunk] -> T.Text+expand chunks =+ let + -- map (name, parts)+ partMap = Map.fromList $ zip (map getName chunks) (map getParts chunks)+ backup = getParts $ last chunks+ parts = Map.lookupDefault backup "*" partMap + in+ expandParts parts partMap+expandParts :: [Part] -> Map.HashMap T.Text [Part] -> T.Text+expandParts parts partMap =+ let + toText = (\part -> + case part of+ Code txt -> txt+ Ref name -> expandParts refParts partMap+ where refParts = Map.lookupDefault [] (T.strip name) partMap)+ in + T.concat (map toText parts) `T.append` "\n"+++
+ src/Highlight.hs view
@@ -0,0 +1,56 @@+module Highlight (highlight, getLang) where++import qualified Data.Text as T +import Data.Monoid (mconcat)++import Text.Blaze (toValue, (!))+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A+import Text.Highlighting.Kate ( defaultFormatOpts+ , highlightAs+ , languagesByFilename )+import Text.Highlighting.Kate.Types ++highlight :: String -> T.Text -> H.Html+highlight lang txt = + let+ highlighted = highlightAs lang (T.unpack txt)+ htmlList = map sourceLineToHtml highlighted+ in + mconcat htmlList++sourceLineToHtml :: SourceLine -> H.Html+sourceLineToHtml line = mconcat $ htmlList ++ [H.toHtml "\n"]+ where+ htmlList = map (tokenToHtml defaultFormatOpts) line++tokenToHtml :: FormatOptions -> Token -> H.Html+tokenToHtml _ (NormalTok, str) = H.toHtml str+tokenToHtml opts (toktype, str) =+ if titleAttributes opts+ then sp ! A.title (toValue $ show toktype)+ else sp + where sp = H.span ! A.class_ (toValue $ short toktype) $ H.toHtml str++short :: TokenType -> String+short KeywordTok = "kw"+short DataTypeTok = "dt"+short DecValTok = "dv"+short BaseNTok = "bn"+short FloatTok = "fl"+short CharTok = "ch"+short StringTok = "st"+short CommentTok = "co"+short OtherTok = "ot"+short AlertTok = "al"+short FunctionTok = "fu"+short RegionMarkerTok = "re"+short ErrorTok = "er"+short NormalTok = ""++getLang path = + case languagesByFilename path of+ [] -> ""+ lst -> head lst++
+ src/Html.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}+module Html (generate) where++import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Data.Maybe (fromMaybe)++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)+import Cheapskate (markdown, def)+import Cheapskate.Html++import Highlight+import Types++generate :: Maybe String -> String -> [Chunk] -> T.Text+generate maybeCss name chunks = + let + lang = getLang name+ mergedProse = simplify chunks -- adjacent Prose combined to one prose+ body = H.preEscapedToHtml $ map (chunkToHtml lang) mergedProse+ doc = preface maybeCss name body+ in + TL.toStrict $ renderHtml doc++(<++>) :: T.Text -> T.Text -> T.Text+(<++>) = T.append++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++simplify :: [Chunk] -> [Chunk]+simplify [] = []+simplify lst =+ let + (defs, ps) = span isDef lst+ (ps', rest) = break isDef ps+ mergeProse chunks = Prose $ T.concat $ map getProseText chunks+ in case ps' of+ [] -> defs ++ rest+ _ -> defs ++ [mergeProse ps'] ++ (simplify rest)++chunkToHtml :: String -> Chunk -> H.Html+chunkToHtml lang chunk =+ case chunk of+ Prose txt -> H.toHtml $ markdown def txt+ Def _ name parts -> + let + header = headerToHtml name+ htmlParts = H.preEscapedToHtml $ map (partToHtml lang) parts+ in + H.pre $ H.code $ (header >> htmlParts)++partToHtml :: String -> Part -> H.Html+partToHtml lang part =+ case part of+ Code txt -> highlight lang txt+ Ref txt -> H.preEscapedToHtml ("<< " <++> link <++> " >>\n")+ where+ link = "<a href=\"#" <++> underscored <++> "\">" <++> slim <++> "</a>"+ slim = T.strip txt+ underscored = underscore slim ++headerToHtml :: T.Text -> H.Html+headerToHtml name = H.preEscapedToHtml $ "<< " <++> link <++> " >>=\n" + where+ link = "<a id=\"" <++> underscored <++> "\" href=\"#" <++> underscored <++> "\">" <++> slim <++> "</a>"+ slim = T.strip name+ underscored = underscore slim++underscore :: T.Text -> T.Text+underscore txt =+ T.pack $ concatMap (\c -> if c == ' ' then "_" else [c]) $ T.unpack txt+++
+ src/Markdown.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}+module Markdown ( generate ) where++import qualified Data.Text as T++import Types+import Highlight (getLang)++generate :: String -> [Chunk] -> T.Text+generate name chunks = + let + lang = getLang name+ toMarkDown = chunkToMarkdown lang+ in+ T.concat $ map toMarkDown chunks++(<++>) :: T.Text -> T.Text -> T.Text+(<++>) = T.append++chunkToMarkdown lang chunk =+ case chunk of+ Prose text -> text+ Def _ name parts -> + let + lang' = T.pack lang+ header = "<< " <++> (T.strip name) <++> " >>="+ mdParts = T.concat $ map (partToText lang) parts+ in + "```" <++> lang' <++> + "\n" <++> header <++> + "\n" <++> mdParts <++> "```\n"++partToText :: String -> Part -> T.Text+partToText lang part =+ case part of+ Code txt -> txt+ Ref txt -> ("<< " <++> (T.strip txt) <++> " >>\n")+++
src/Parse.hs view
@@ -13,18 +13,6 @@ Left err -> [] Right result -> result -textP :: Parsec T.Text () T.Text -> T.Text -> T.Text-textP p txt =- case (parse p "" txt) of - Left err -> T.empty- Right result -> result--chunkP :: Parsec T.Text () Chunk -> T.Text -> Maybe Chunk-chunkP p txt =- case (parse p "" txt) of - Left err -> Nothing- Right result -> Just result- entire :: Parser Program entire = manyTill chunk eof @@ -32,10 +20,7 @@ chunk = (try def) <|> prose prose :: Parser Chunk-prose = do - txt <- packM =<< many (noneOf "\n\r")- nl <- eol >>= (\c -> return $ T.singleton c)- return $ Prose (txt `T.append` nl)+prose = grabLine >>= (\line -> return $ Prose line) def :: Parser Chunk def = do@@ -43,49 +28,59 @@ parts <- manyTill (part indent) $ endDef indent return $ Def lineNum header parts +endDef :: String -> Parser ()+endDef indent = try $ do { skipMany newline; notFollowedBy (string indent) <|> (lookAhead title >> parserReturn ()) }++-- Returns (indent, macro-name, line-no)+title :: Parser (String, T.Text, Int)+title = do+ pos <- getPosition+ indent <- many ws+ name <- packM =<< between (string "<<") (string ">>=") (many notDelim)+ newline+ return $ (indent, T.strip name, sourceLine pos)++notDelim = noneOf ">="+ part :: String -> Parser Part-part indent =+part indent = try (string indent >> varLine) <|> - try (string indent >> defLine) <|> - (grabLine >>= (\extra -> return (Code $ extra)))- --(newline >>= (\nl -> return (Code $ T.singleton nl)))+ try (string indent >> defLine) <|>+ (grabLine >>= \extra -> return $ Code extra) varLine :: Parser Part varLine = do name <- packM =<< between (string "<<") (string ">>") (many notDelim)- eol+ newline return $ Ref name defLine :: Parser Part defLine = do- line <- grabLine + line <- grabLine return $ Code line -endDef :: String -> Parser ()-endDef indent = try $ do { skipMany newline; notFollowedBy (string indent) <|> (lookAhead title >> parserReturn ()) }--beginDef = try $ do {lookAhead title >> parserReturn ()}- grabLine :: Parser T.Text grabLine = do - line <- packM =<< many (noneOf "\n\r")- last <- eol >>= (\c -> return $ T.singleton c)- return $ line `T.append` last+ line <- many (noneOf "\n\r")+ last <- newline+ return $ T.pack $ line ++ [last] +ws :: Parser Char+ws = char ' ' <|> char '\t'++ packM str = return $ T.pack str --- Pre: Assumes that parser is looking at a fresh line with a macro defn--- Post: Returns (indent, macro-name, line-no)-title :: Parser (String, T.Text, Int)-title = do- pos <- getPosition- indent <- many ws- name <- packM =<< between (string "<<") (string ">>=") (many notDelim)- eol- return $ (indent, T.strip name, sourceLine pos)+textP :: Parsec T.Text () T.Text -> T.Text -> T.Text+textP p txt =+ case (parse p "" txt) of + Left err -> T.empty+ Right result -> result -notDelim = noneOf ">="-ws :: Parser Char-ws = char ' ' <|> char '\t' -- consume a whitespace char-eol :: Parser Char-eol = char '\n' <|> char '\r'+chunkP :: Parsec T.Text () Chunk -> T.Text -> Maybe Chunk+chunkP p txt =+ case (parse p "" txt) of + Left err -> Nothing+ Right result -> Just result++
src/Poll.hs view
@@ -7,31 +7,30 @@ import Control.Monad (forever) import qualified Control.Concurrent as C import System.IO.Error- + watch :: (String -> IO ()) -> [String] -> IO ()-watch fun fs = do +watch fun fs = + let + wait = C.threadDelay 1000000+ in 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 $ (C.threadDelay 1000000 >> mapM_ (onDiff fun delay) fs)+ forever $ (wait >> mapM_ (onChange fun) fs) -onDiff :: (String -> IO ()) -> Int -> String -> IO ()-onDiff fun delay file = do- modified <- errorHandler (getModificationTime file) +onChange :: (String -> IO ()) -> String -> IO ()+onChange fun file = do+ modified <- retryAtMost 10 (getModificationTime file) curTime <- getCurrentTime let diff = (diffUTCTime curTime modified)- 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 10+ if diff < 2 then fun file else return () -errorHandlerNTimes 0 mnd = catchIOError mnd (\e -> ioError e)-errorHandlerNTimes times mnd = {-(putStrLn $ show times) >>-} catchIOError mnd handle - where - handle e =- if isDoesNotExistError e - then C.threadDelay 50000 >> errorHandlerNTimes (times - 1) mnd+retryAtMost 1 action = catchIOError action (\e -> ioError e)+retryAtMost times action = + let+ handle e = if isDoesNotExistError e + then C.threadDelay 50000 >> retryAtMost (times - 1) action else ioError e+ in + catchIOError action handle ++
− src/Pretty.hs
@@ -1,132 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Pretty -( pretty-, mark -, getLang ) where--import qualified Data.Text as T-import qualified Data.Text.Lazy as TL--import Cheapskate (markdown, def)-import Cheapskate.Html-import Text.Highlighting.Kate (defaultFormatOpts, highlightAs, languagesByFilename)-import Text.Highlighting.Kate.Types -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)--import Data.List (intersperse)-import Data.Maybe (fromMaybe)-import Data.Monoid (mconcat)--import Types--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--chunkToMarkdown lang chunk =- case chunk of- Prose text -> text- Def _ name parts -> - let - lang' = T.pack lang- header = headerName name- mdParts = T.concat $ map (partToText lang) parts- in - "```" `T.append` lang' `T.append` - "\n" `T.append` header `T.append` - "\n" `T.append` mdParts `T.append` "```\n"---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 -> H.toHtml $ markdown def txt- Def _ name parts -> - let - header = headerToHtml name- htmlParts = H.preEscapedToHtml $ map (partToHtml lang) parts- in H.pre $ H.code $ (header >> htmlParts)--partToHtml :: String -> Part -> H.Html-partToHtml lang part =- case part of- Code txt -> mconcat $ map (sourceLineToHtml defaultFormatOpts) - $ highlightAs lang (T.unpack txt)- Ref txt -> H.preEscapedToHtml ("<< " `T.append` link `T.append` " >>\n")- where- link = "<a href=\"#" `T.append` slim `T.append` "\">" `T.append` slim `T.append` "</a>"- slim = T.strip txt--partToText :: String -> Part -> T.Text-partToText lang part =- case part of- Code txt -> txt- Ref txt -> ("<< " `T.append` (T.strip txt) `T.append` " >>\n")--headerToHtml :: T.Text -> H.Html-headerToHtml name = H.preEscapedToHtml $ headerToText name--headerToText :: T.Text -> T.Text-headerToText name = "<< " `T.append` link `T.append` " >>=\n" - where- link = "<a id=\"" `T.append` slim `T.append` "\" href=\"#" `T.append` slim `T.append` "\">" `T.append` slim `T.append` "</a>"- slim = T.strip name--headerName name = "<< " `T.append` (T.strip name) `T.append` " >>="---- The methods below were heavily derived from John MacFarlane's highlighting-kate source-tokenToHtml :: FormatOptions -> Token -> H.Html-tokenToHtml _ (NormalTok, txt) = H.toHtml txt-tokenToHtml opts (toktype, txt) =- if titleAttributes opts- then sp ! A.title (toValue $ show toktype)- else sp- where sp = H.span ! A.class_ (toValue $ short toktype) $ H.toHtml txt--sourceLineToHtml :: FormatOptions -> SourceLine -> H.Html-sourceLineToHtml opts line = mconcat $ (map (tokenToHtml opts) line) ++ [(H.toHtml ("\n" :: String))]--short :: TokenType -> T.Text-short KeywordTok = "kw"-short DataTypeTok = "dt"-short DecValTok = "dv"-short BaseNTok = "bn"-short FloatTok = "fl"-short CharTok = "ch"-short StringTok = "st"-short CommentTok = "co"-short OtherTok = "ot"-short AlertTok = "al"-short FunctionTok = "fu"-short RegionMarkerTok = "re"-short ErrorTok = "er"-short NormalTok = ""--getLang path = - case languagesByFilename path of- [] -> ""- lst -> head lst
+ src/Process.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}+module Process+( process+, htmlPipeline+, mdPipeline+, codePipeline ) where++import Prelude hiding (readFile, writeFile)+import Data.Text.IO (writeFile, readFile)+import System.FilePath.Posix (takeFileName, dropExtension)+import System.Directory+import System.FilePath.Posix+import Data.List (intercalate)+import qualified Data.Text as T++import Parse (encode)+import Code+import Html+import Markdown+import Types++process pipes file = do + stream <- readFile file+ encoded <- return $ encode stream + mapM_ (\f -> f fileName encoded) pipes >> return ()+ where+ fileName = dropExtension $ takeFileName file++htmlPipeline dir mCss name enc = do+ maybeCss <- cssRelativeToOutput dir mCss+ let path = (addTrailingPathSeparator dir) ++ name ++ ".html"+ output = Html.generate maybeCss name enc+ writeFile path output++mdPipeline dir css name enc = writeFile path output+ where+ path = (addTrailingPathSeparator dir) ++ name ++ ".md"+ output = Markdown.generate name enc++codePipeline dir css name enc = writeFile path output+ where+ path = (addTrailingPathSeparator dir) ++ name+ output = Code.generate enc++cssRelativeToOutput :: String -> Maybe String -> IO (Maybe String)+cssRelativeToOutput output mCss =+ case mCss of+ Nothing -> return Nothing+ Just css -> do+ getCurrentDirectory >>= canonicalizePath >>= \path -> return $ Just $ (join' . helper' . trim' . split') path+ where + moves = filter (\str -> str /= ".") $ splitDirectories output+ split' = splitDirectories+ trim' = trimToMatchLength moves+ helper' = reversePath moves []+ join' path = (intercalate "/" path) </> css++trimToMatchLength list listToTrim = + let len1 = length list+ len2 = length listToTrim+ in + drop (len2 - len1) listToTrim++reversePath [] solution curPathParts = solution+reversePath (fst:rest) solution curPathParts =+ if fst == ".."+ then reversePath rest ((last curPathParts) : solution) (init curPathParts)+ else reversePath rest (".." : solution) (curPathParts ++ [fst])+++
− src/Processing.hs
@@ -1,110 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Processing -( build-, htmlPipeline-, mdPipeline-, 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-import qualified Data.Text as T--import Parse-import Pretty-import Types--build mCss pipes 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 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)--ensureTrailingSlash dir = - if last dir == '/'- then dir- else dir ++ "/"---- merge together definitions with the same name-merge :: [Chunk] -> [Chunk]-merge chunks = mergeAux [] (filter isDef chunks)-mergeAux ans [] = ans-mergeAux ans (next:rest) = - let - name = getName next- (found, rem) = partition (sameName name) rest - merged = combineChunks (next:found)- in - mergeAux (merged:ans) rem--consecutive :: [Chunk] -> ([Chunk],[Chunk])-consecutive [] = ([],[])-consecutive lst@(fst:rest) =- case fst of- Prose _ -> break isDef lst- Def _ _ _ -> span isDef lst---- assumes always one or more chunk-combineChunks :: [Chunk] -> Chunk-combineChunks (a:[]) = a-combineChunks l@(c:cs) = Def line name parts - where- parts = concatMap getParts l- name = getName c- line = getLineNo c--isDef chunk =- case chunk of- Def _ _ _ -> True- Prose _ -> False--getProseText prose =- case prose of- Prose txt -> txt- _ -> error "cannot retrieve txt, not a prose"--getName chunk =- case chunk of- Def _ name _ -> name- _ -> error "cannot retrieve name, not a chunk"--getParts chunk =- case chunk of- Def _ _ parts -> parts- _ -> error "cannot retrieve parts, not a chunk"--getLineNo chunk =- case chunk of- Def line _ _ -> line- _ -> error "cannot retrieve line number, not a chunk"--sameName name chunk = name == (getName chunk)--expand :: [Chunk] -> T.Text-expand chunks =- let - -- map (name, parts)- partMap = Map.fromList $ zip (map getName chunks) (map getParts chunks)- rootParts = Map.lookupDefault [] "*" partMap - in- expandParts rootParts partMap- -expandParts :: [Part] -> Map.HashMap T.Text [Part] -> T.Text-expandParts parts partMap =- let - toText = (\part -> - case part of- Code txt -> txt- Ref name -> expandParts refParts partMap- where refParts = Map.lookupDefault [] (T.strip name) partMap)- in - T.concat (map toText parts) `T.append` "\n"
src/Types.hs view
@@ -5,3 +5,26 @@ data Chunk = Def Int Text [Part] | Prose Text deriving (Show, Eq) data Part = Code Text | Ref Text deriving (Show, Eq) type Program = [Chunk]++isDef chunk =+ case chunk of+ Def _ _ _ -> True+ Prose _ -> False+getName chunk =+ case chunk of+ Def _ name _ -> name+ _ -> error "cannot retrieve name, not a def"+getParts chunk =+ case chunk of+ Def _ _ parts -> parts+ _ -> error "cannot retrieve parts, not a def"+getLineNo chunk =+ case chunk of+ Def line _ _ -> line+ _ -> error "cannot retrieve line number, not a def"+getProseText chunk = + case chunk of+ Prose txt -> txt+ _ -> error "cannot retrieve text, not a prose"++
src/lit.hs view
@@ -7,7 +7,7 @@ import System.Exit import Control.Applicative -import Processing+import Process import Poll data Options = Options { optCodeDir :: String @@ -82,6 +82,7 @@ "Display help" ] + usage = "Usage: lit OPTIONS... FILES..." help = "Try: lit --help" @@ -90,8 +91,6 @@ -- Parse options, getting a list of option actions let (actions, files, errors) = getOpt Permute options args- - -- Here we thread startOptions through all supplied option actions opts <- foldl (>>=) (return startOptions) actions let Options { optCodeDir = codeDir@@ -102,19 +101,18 @@ , optCss = mCss , optWatch = watching } = opts - codeDirCheck <- doesDirectoryExist codeDir docsDirCheck <- doesDirectoryExist docsDir-- let htmlPipe = if html then [Processing.htmlPipeline docsDir] else []- mdPipe = if markdown then [Processing.mdPipeline docsDir] else []- codePipe = if code then [Processing.codePipeline codeDir] else []+ let htmlPipe = if html then [Process.htmlPipeline docsDir mCss] else []+ mdPipe = if markdown then [Process.mdPipeline docsDir mCss] else []+ codePipe = if code then [Process.codePipeline codeDir mCss] else [] pipes = htmlPipe ++ mdPipe ++ codePipe maybeWatch = if watching then Poll.watch else mapM_ errors' = if codeDirCheck then [] else ["Directory: " ++ codeDir ++ " does not exist\n"] errors'' = if docsDirCheck then [] else ["Directory: " ++ docsDir ++ " does not exist\n"] allErr = errors ++ errors' ++ errors''- if allErr /= [] || (not html && not code && not markdown) || files == [] then hPutStrLn stderr ((concat allErr) ++ help) - else (maybeWatch (Processing.build mCss pipes)) files+ else (maybeWatch (Process.process pipes)) files++