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.1.0
+version: 0.1.10.0
synopsis: A simple tool for literate programming
description: lit has a minimal syntax for implementing literate
programming. It generates both HTML and the native
diff --git a/src/Code.hs b/src/Code.hs
--- a/src/Code.hs
+++ b/src/Code.hs
@@ -13,28 +13,27 @@
annotate :: String -> [Chunk] -> [Chunk]
annotate langExt chunks = map annotateChunk chunks
- where
- annotateChunk (Def sourcePos name parts) =
+ where
+ annotateChunk (Def sourcePos name parts) =
Def sourcePos name $ (Code $ annotation sourcePos):parts
annotation sourcePos = T.pack $ annotateForLang langExt (sourceName sourcePos) (sourceLine sourcePos) ++ "\n"
- annotateForLang ext filePath lineNo = (comment ext) ++ " " ++ filePath ++ ":" ++ (show lineNo)
- comment ".sh" = "#"
- comment ".hs" = "--"
- comment _ = "//"
+ annotateForLang ".sh" filePath lineNo = "# " ++ filePath ++ ":" ++ (show lineNo)
+ annotateForLang ".hs" filePath lineNo = "-- " ++ filePath ++ ":" ++ (show lineNo)
+ annotateForLang _ filePath lineNo = "// " ++ filePath ++ ":" ++ (show lineNo)
merge :: [Chunk] -> [Chunk]
merge = mergeAux []
mergeAux ans [] = ans
-mergeAux ans (next:rest) =
- let
+mergeAux ans (next:rest) =
+ let
name = getName next
chunkHasName name = (== name) . getName
- (found, rem) = partition (chunkHasName name) rest
+ (found, rem) = partition (chunkHasName name) rest
merged = combineChunks (next:found)
- in
+ in
mergeAux (merged:ans) rem
combineChunks :: [Chunk] -> Chunk
combineChunks (a:[]) = a
-combineChunks l@(c:cs) = Def line name parts
+combineChunks l@(c:cs) = Def line name parts
where
parts = concatMap getParts l
name = getName c
@@ -42,15 +41,15 @@
expand :: [Chunk] -> T.Text
expand chunks =
expandParts parts partMap T.empty
- where
+ where
-- map (name, parts)
partMap = Map.fromList $ zip (map getName chunks) (map getParts chunks)
backup = getParts $ last chunks
- parts = Map.lookupDefault backup "*" partMap
+ parts = Map.lookupDefault backup "*" partMap
expandParts :: [Part] -> Map.HashMap T.Text [Part] -> T.Text -> T.Text
expandParts parts partMap baseIndent =
T.concat $ map toText parts
- where
+ where
toText part =
case part of
Code txt -> T.append baseIndent txt
diff --git a/src/Highlight.hs b/src/Highlight.hs
--- a/src/Highlight.hs
+++ b/src/Highlight.hs
@@ -1,5 +1,5 @@
module Highlight (highlight, getLang) where
-import qualified Data.Text as T
+import qualified Data.Text as T
import Data.Monoid (mconcat)
import Text.Blaze (toValue, (!))
@@ -8,13 +8,13 @@
import Text.Highlighting.Kate ( defaultFormatOpts
, highlightAs
, languagesByFilename )
-import Text.Highlighting.Kate.Types
+import Text.Highlighting.Kate.Types
highlight :: String -> T.Text -> H.Html
-highlight lang txt =
+highlight lang txt =
let
highlighted = highlightAs lang (T.unpack txt)
htmlList = map sourceLineToHtml highlighted
- in
+ in
mconcat htmlList
sourceLineToHtml :: SourceLine -> H.Html
sourceLineToHtml line = mconcat $ htmlList ++ [H.toHtml "\n"]
@@ -25,7 +25,7 @@
tokenToHtml opts (toktype, str) =
if titleAttributes opts
then sp ! A.title (toValue $ show toktype)
- else sp
+ else sp
where sp = H.span ! A.class_ (toValue $ short toktype) $ H.toHtml str
short :: TokenType -> String
short KeywordTok = "kw"
@@ -42,7 +42,7 @@
short RegionMarkerTok = "re"
short ErrorTok = "er"
short NormalTok = ""
-getLang path =
+getLang path =
case languagesByFilename path of
[] -> ""
lst -> head lst
diff --git a/src/Html.hs b/src/Html.hs
--- a/src/Html.hs
+++ b/src/Html.hs
@@ -14,36 +14,36 @@
import Highlight
import Types
generate :: Maybe String -> String -> [Chunk] -> T.Text
-generate maybeCss name chunks =
- let
+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
+ 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
+ let
cssPath = fromMaybe "" maybeCss
cssAttr = toValue cssPath
- includeCss =
+ 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
+ in
+ H.docTypeHtml $ do
H.head $ do
H.title $ H.toHtml fileName
- H.meta ! A.charset "UTF-8"
+ H.meta ! A.charset "UTF-8"
includeCss
H.body $ do bodyHtml
simplify :: [Chunk] -> [Chunk]
simplify [] = []
simplify lst =
- let
+ let
(defs, ps) = span isDef lst
(ps', rest) = break isDef ps
mergeProse chunks = Prose $ T.concat $ map getProseText chunks
@@ -54,11 +54,11 @@
chunkToHtml lang chunk =
case chunk of
Prose txt -> H.toHtml $ markdown def txt
- Def _ name parts ->
- let
+ Def _ name parts ->
+ let
header = headerToHtml name
htmlParts = H.preEscapedToHtml $ map (partToHtml lang) parts
- in
+ in
H.pre $ H.code $ (header >> htmlParts)
partToHtml :: String -> Part -> H.Html
partToHtml lang part =
@@ -68,9 +68,9 @@
where
link = " underscored <++> "\">" <++> slim <++> ""
slim = T.strip txt
- underscored = underscore slim
+ underscored = underscore slim
headerToHtml :: T.Text -> H.Html
-headerToHtml name = H.preEscapedToHtml $ "<< " <++> link <++> " >>=\n"
+headerToHtml name = H.preEscapedToHtml $ "<< " <++> link <++> " >>=\n"
where
link = " underscored <++> "\" href=\"#" <++> underscored <++> "\">" <++> slim <++> ""
slim = T.strip name
diff --git a/src/Markdown.hs b/src/Markdown.hs
--- a/src/Markdown.hs
+++ b/src/Markdown.hs
@@ -5,8 +5,8 @@
import Types
import Highlight (getLang)
generate :: String -> [Chunk] -> T.Text
-generate name chunks =
- let
+generate name chunks =
+ let
lang = getLang name
toMarkDown = chunkToMarkdown lang
in
@@ -16,14 +16,14 @@
chunkToMarkdown lang chunk =
case chunk of
Prose text -> text
- Def _ name parts ->
- let
+ Def _ name parts ->
+ let
lang' = T.pack lang
header = "<< " <++> (T.strip name) <++> " >>="
mdParts = T.concat $ map (partToText lang) parts
- in
- "```" <++> lang' <++>
- "\n" <++> header <++>
+ in
+ "```" <++> lang' <++>
+ "\n" <++> header <++>
"\n" <++> mdParts <++> "```\n"
partToText :: String -> Part -> T.Text
partToText lang part =
diff --git a/src/Parse.hs b/src/Parse.hs
--- a/src/Parse.hs
+++ b/src/Parse.hs
@@ -7,7 +7,7 @@
import Types
encode :: T.Text -> String -> [Chunk]
encode txt fileName =
- case (parse entire fileName txt) of
+ case (parse entire fileName txt) of
Left err -> []
Right result -> result
entire :: Parser Program
@@ -33,8 +33,8 @@
return $ (indent, T.strip name, pos)
notDelim = noneOf ">="
part :: String -> Parser Part
-part indent =
- try (string indent >> varLine) <|>
+part indent =
+ try (string indent >> varLine) <|>
try (string indent >> defLine) <|>
(grabLine >>= \extra -> return $ Code extra)
varLine :: Parser Part
@@ -48,7 +48,7 @@
line <- grabLine
return $ Code line
grabLine :: Parser T.Text
-grabLine = do
+grabLine = do
line <- many (noneOf "\n\r")
last <- newline
return $ T.pack $ line ++ [last]
@@ -57,12 +57,12 @@
packM str = return $ T.pack str
textP :: Parsec T.Text () T.Text -> T.Text -> T.Text
textP p txt =
- case (parse p "" txt) of
+ 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
+ case (parse p "" txt) of
Left err -> Nothing
Right result -> Just result
diff --git a/src/Poll.hs b/src/Poll.hs
--- a/src/Poll.hs
+++ b/src/Poll.hs
@@ -1,4 +1,4 @@
-module Poll
+module Poll
( watch ) where
import System.Directory
import Data.Time.Clock
@@ -7,24 +7,24 @@
import qualified Control.Concurrent as C
import System.IO.Error
watch :: (String -> IO ()) -> [String] -> IO ()
-watch fun fs =
- let
+watch fun fs =
+ let
wait = C.threadDelay 1000000
- in do
+ in do
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
+ 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 =
+retryAtMost times action =
let
- handle e = if isDoesNotExistError e
+ handle e = if isDoesNotExistError e
then C.threadDelay 50000 >> retryAtMost (times - 1) action
else ioError e
- in
- catchIOError action handle
+ in
+ catchIOError action handle
diff --git a/src/Process.hs b/src/Process.hs
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -17,7 +17,7 @@
import Html
import Markdown
import Types
-process pipes file = do
+process pipes file = do
stream <- readFile file
encoded <- return $ encode stream file
mapM_ (\f -> f fileName encoded) pipes >> return ()
@@ -36,27 +36,27 @@
where
path = (addTrailingPathSeparator dir) ++ name
ext = takeExtension name
- output =
- if showLines
- then Code.generateWithAnnotation ext enc
- else Code.generate enc
+ output =
+ if showLines
+ then Code.generateWithAnnotation ext enc
+ else 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
+ where
moves = filter (\str -> str /= ".") $ splitDirectories output
split' = splitDirectories
trim' = trimToMatchLength moves
helper' = reversePath moves []
join' path = (intercalate "/" path) css
-trimToMatchLength list listToTrim =
+trimToMatchLength list listToTrim =
let len1 = length list
len2 = length listToTrim
- in
+ in
drop (len2 - len1) listToTrim
reversePath [] solution curPathParts = solution
diff --git a/src/Types.hs b/src/Types.hs
--- a/src/Types.hs
+++ b/src/Types.hs
@@ -1,6 +1,6 @@
module Types where
-import Data.Text
+import Data.Text
import Text.Parsec (SourcePos)
data Chunk = Def SourcePos Text [Part] | Prose Text deriving (Show, Eq)
data Part = Code Text | Ref Text Text deriving (Show, Eq)
@@ -17,7 +17,7 @@
case chunk of
Def _ name _ -> name
_ -> error "cannot retrieve name, not a def"
-getCodeText part =
+getCodeText part =
case part of
Code txt -> txt
_ -> error "cannot retrieve text, not a code part"
@@ -29,7 +29,7 @@
case chunk of
Def line _ _ -> line
_ -> error "cannot retrieve line number, not a def"
-getProseText chunk =
+getProseText chunk =
case chunk of
Prose txt -> txt
_ -> error "cannot retrieve text, not a prose"
diff --git a/src/lit.hs b/src/lit.hs
--- a/src/lit.hs
+++ b/src/lit.hs
@@ -9,7 +9,7 @@
import Process
import Poll
-data Options = Options { optCodeDir :: String
+data Options = Options { optCodeDir :: String
, optDocsDir :: String
, optCss :: Maybe String
, optCode :: Bool
@@ -29,7 +29,7 @@
, optNumber = False
}
options :: [ OptDescr (Options -> IO Options) ]
-options =
+options =
[ Option "h" ["html"]
(NoArg (\opt -> return opt { optHtml = True }))
"Generate html"
@@ -44,7 +44,7 @@
, Option "n" ["number"]
(NoArg (\opt -> return opt { optNumber = True }))
- "Add annotations to generated code noting the source lit file and line number"
+ "Add annotations to generated code noting the lit file and line from which it came"
, Option "" ["css"]
(ReqArg
@@ -68,14 +68,14 @@
(NoArg
(\opt -> return opt { optWatch = True}))
"Watch for file changes, automatically run lit"
-
+
, Option "v" ["version"]
(NoArg
(\_ -> do
- hPutStrLn stderr "Version 0.1.1.0"
+ hPutStrLn stderr "Version 0.1.10.0"
exitWith ExitSuccess))
"Print version"
-
+
, Option "" ["help"]
(NoArg
(\_ -> do
@@ -88,11 +88,11 @@
help = "Try: lit --help"
main = do
args <- getArgs
-
+
-- Parse options, getting a list of option actions
let (actions, files, errors) = getOpt Permute options args
opts <- foldl (>>=) (return startOptions) actions
-
+
let Options { optCodeDir = codeDir
, optDocsDir = docsDir
, optMarkdown = markdown
@@ -101,17 +101,17 @@
, optCss = mCss
, optWatch = watching
, optNumber = showLines
- } = opts
+ } = opts
codeDirCheck <- doesDirectoryExist codeDir
docsDirCheck <- doesDirectoryExist docsDir
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 showLines] else []
- pipes = htmlPipe ++ mdPipe ++ codePipe
+ 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)
+ then hPutStrLn stderr ((concat allErr) ++ help)
else (maybeWatch (Process.process pipes)) files