lit 0.1.0.5 → 0.1.0.9
raw patch · 10 files changed
+25/−98 lines, 10 filesdep ~blaze-htmldep ~filepathdep ~time
Dependency ranges changed: blaze-html, filepath, time
Files
- lit.cabal +4/−4
- src/Code.hs +7/−15
- src/Highlight.hs +0/−8
- src/Html.hs +1/−13
- src/Markdown.hs +1/−9
- src/Parse.hs +2/−20
- src/Poll.hs +0/−6
- src/Process.hs +0/−9
- src/Types.hs +9/−5
- src/lit.hs +1/−9
lit.cabal view
@@ -1,7 +1,7 @@ -- Initial lit.cabal generated by cabal init. For further documentation, name: lit-version: 0.1.0.5+version: 0.1.0.9 synopsis: A simple tool for literate programming description: lit has a minimal syntax for implementing literate programming. It generates both HTML and the native@@ -27,11 +27,11 @@ build-depends: base ==4.*, text >= 1 && < 2, parsec ==3.*, - filepath ==1.3.*,+ filepath ==1.4.*, unordered-containers ==0.2.*, cheapskate ==0.1.*, blaze-markup ==0.6.*,- blaze-html == 0.7.*,+ blaze-html == 0.7.0.3, highlighting-kate ==0.5.*,- time ==1.4.*,+ time ==1.5.*, directory ==1.2.*
src/Code.hs view
@@ -1,15 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module Code ( generate ) where--import Data.List (partition)+import Data.List (partition, intersperse) 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@@ -21,7 +18,6 @@ merged = combineChunks (next:found) in mergeAux (merged:ans) rem- combineChunks :: [Chunk] -> Chunk combineChunks (a:[]) = a combineChunks l@(c:cs) = Def line name parts @@ -29,7 +25,6 @@ parts = concatMap getParts l name = getName c line = getLineNo c- expand :: [Chunk] -> T.Text expand chunks = let @@ -38,17 +33,14 @@ 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 =+ expandParts parts partMap T.empty+expandParts :: [Part] -> Map.HashMap T.Text [Part] -> T.Text -> T.Text+expandParts parts partMap baseIndent = let toText = (\part -> case part of- Code txt -> txt- Ref name -> expandParts refParts partMap+ Code txt -> T.append baseIndent txt+ Ref name indent -> (expandParts refParts partMap (T.append baseIndent indent)) where refParts = Map.lookupDefault [] (T.strip name) partMap) in - T.concat (map toText parts) `T.append` "\n"---+ T.concat $ map toText parts
src/Highlight.hs view
@@ -1,5 +1,4 @@ module Highlight (highlight, getLang) where- import qualified Data.Text as T import Data.Monoid (mconcat) @@ -10,7 +9,6 @@ , highlightAs , languagesByFilename ) import Text.Highlighting.Kate.Types - highlight :: String -> T.Text -> H.Html highlight lang txt = let@@ -18,12 +16,10 @@ 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) =@@ -31,7 +27,6 @@ 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"@@ -47,10 +42,7 @@ short RegionMarkerTok = "re" short ErrorTok = "er" short NormalTok = ""- getLang path = case languagesByFilename path of [] -> "" lst -> head lst--
src/Html.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} module Html (generate) where- import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Maybe (fromMaybe)@@ -14,7 +13,6 @@ import Highlight import Types- generate :: Maybe String -> String -> [Chunk] -> T.Text generate maybeCss name chunks = let @@ -24,10 +22,8 @@ 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 @@ -44,7 +40,6 @@ H.meta ! A.charset "UTF-8" includeCss H.body $ do bodyHtml- simplify :: [Chunk] -> [Chunk] simplify [] = [] simplify lst =@@ -55,7 +50,6 @@ in case ps' of [] -> defs ++ rest _ -> defs ++ [mergeProse ps'] ++ (simplify rest)- chunkToHtml :: String -> Chunk -> H.Html chunkToHtml lang chunk = case chunk of@@ -66,27 +60,21 @@ 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")+ Ref txt indent -> H.preEscapedToHtml (indent <++> "<< " <++> 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
@@ -1,11 +1,9 @@ {-# 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 @@ -13,10 +11,8 @@ 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@@ -29,12 +25,8 @@ "```" <++> 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")---+ Ref txt indent -> (indent <++> "<< " <++> (T.strip txt) <++> " >>\n")
src/Parse.hs view
@@ -1,36 +1,28 @@ {-# LANGUAGE OverloadedStrings #-} module Parse where- import Text.Parsec import Text.Parsec.Text import qualified Data.Text as T import Types- encode :: T.Text -> [Chunk] encode txt = case (parse entire "" txt) of Left err -> [] Right result -> result- entire :: Parser Program entire = manyTill chunk eof- chunk :: Parser Chunk chunk = (try def) <|> prose- prose :: Parser Chunk prose = grabLine >>= (\line -> return $ Prose line)- def :: Parser Chunk def = do (indent, header, lineNum) <- title 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@@ -39,38 +31,30 @@ name <- packM =<< between (string "<<") (string ">>=") (many notDelim) newline return $ (indent, T.strip name, sourceLine pos)- notDelim = noneOf ">="- part :: String -> Parser Part part indent = try (string indent >> varLine) <|> try (string indent >> defLine) <|> (grabLine >>= \extra -> return $ Code extra)- varLine :: Parser Part varLine = do+ indent <- packM =<< many ws name <- packM =<< between (string "<<") (string ">>") (many notDelim) newline- return $ Ref name-+ return $ Ref name indent defLine :: Parser Part defLine = do line <- grabLine return $ Code line- grabLine :: Parser T.Text grabLine = do 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- textP :: Parsec T.Text () T.Text -> T.Text -> T.Text textP p txt = case (parse p "" txt) of @@ -82,5 +66,3 @@ case (parse p "" txt) of Left err -> Nothing Right result -> Just result--
src/Poll.hs view
@@ -1,13 +1,11 @@ module Poll ( watch ) where- import System.Directory import Data.Time.Clock import Data.Time.Calendar import Control.Monad (forever) import qualified Control.Concurrent as C import System.IO.Error- watch :: (String -> IO ()) -> [String] -> IO () watch fun fs = let @@ -16,14 +14,12 @@ putStrLn "starting.." mapM_ fun fs forever $ (wait >> mapM_ (onChange fun) fs)- 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 else return ()- retryAtMost 1 action = catchIOError action (\e -> ioError e) retryAtMost times action = let@@ -32,5 +28,3 @@ else ioError e in catchIOError action handle --
src/Process.hs view
@@ -4,7 +4,6 @@ , htmlPipeline , mdPipeline , codePipeline ) where- import Prelude hiding (readFile, writeFile) import Data.Text.IO (writeFile, readFile) import System.FilePath.Posix (takeFileName, dropExtension)@@ -18,30 +17,25 @@ 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@@ -66,6 +60,3 @@ if fst == ".." then reversePath rest ((last curPathParts) : solution) (init curPathParts) else reversePath rest (".." : solution) (curPathParts ++ [fst])---
src/Types.hs view
@@ -1,19 +1,25 @@ module Types where import Data.Text - data Chunk = Def Int Text [Part] | Prose Text deriving (Show, Eq)-data Part = Code Text | Ref Text deriving (Show, Eq)+data Part = Code Text | Ref Text Text deriving (Show, Eq) type Program = [Chunk]- isDef chunk = case chunk of Def _ _ _ -> True Prose _ -> False+isRef part =+ case part of+ Ref _ _ -> True+ _ -> False getName chunk = case chunk of Def _ name _ -> name _ -> error "cannot retrieve name, not a def"+getCodeText part = + case part of+ Code txt -> txt+ _ -> error "cannot retrieve text, not a code part" getParts chunk = case chunk of Def _ _ parts -> parts@@ -26,5 +32,3 @@ case chunk of Prose txt -> txt _ -> error "cannot retrieve text, not a prose"--
src/lit.hs view
@@ -9,7 +9,6 @@ import Process import Poll- data Options = Options { optCodeDir :: String , optDocsDir :: String , optCss :: Maybe String@@ -18,7 +17,6 @@ , optMarkdown :: Bool , optWatch :: Bool }- startOptions :: Options startOptions = Options { optCodeDir = "./" , optDocsDir = "./"@@ -28,7 +26,6 @@ , optMarkdown = False , optWatch = False }- options :: [ OptDescr (Options -> IO Options) ] options = [ Option "h" ["html"]@@ -69,7 +66,7 @@ , Option "v" ["version"] (NoArg (\_ -> do- hPutStrLn stderr "Version 0.01"+ hPutStrLn stderr "Version 0.1.0.9" exitWith ExitSuccess)) "Print version" @@ -81,11 +78,8 @@ exitWith ExitSuccess)) "Display help" ]-- usage = "Usage: lit OPTIONS... FILES..." help = "Try: lit --help"- main = do args <- getArgs @@ -114,5 +108,3 @@ if allErr /= [] || (not html && not code && not markdown) || files == [] then hPutStrLn stderr ((concat allErr) ++ help) else (maybeWatch (Process.process pipes)) files--