lhs2TeX-hl 0.1.4.4 → 0.1.4.5
raw patch · 7 files changed
+89/−55 lines, 7 filesdep +filepathdep +uu-parsinglib
Dependencies added: filepath, uu-parsinglib
Files
- README.asciidoc +8/−0
- lhs2TeX-hl.cabal +3/−1
- src/Base/CLI.hs +4/−3
- src/Base/Common.hs +1/−1
- src/Data/String/Utils.hs +3/−7
- src/Literate/Haskell.hs +10/−28
- src/LiterateHighlighter.hs +60/−15
README.asciidoc view
@@ -158,6 +158,14 @@ CHANGES -------+0.1.4.5::+ * Added support for recursively traversing includes of .lhs files+ * The program now doesn't fail completely when haskell-src-exts fails to parse+ a file. An error is reported and the program continues. :) A fmt file is+ still generated.+ * Removed a faulty command from the list.+ * Added a new url.+ * Cleaned up some code. (Probably introduced other ugly code) 0.1.4.2:: * Removed trace statement 0.1.4.1::
lhs2TeX-hl.cabal view
@@ -1,5 +1,5 @@ Name: lhs2TeX-hl-Version: 0.1.4.4+Version: 0.1.4.5 Cabal-Version: >= 1.6 License: MIT Author: Alessandro Vermeulen <me@alessandrovermeulen.me>@@ -29,6 +29,8 @@ , haskell-src-exts == 1.11.1 , syb >= 0.1.0.1 , cmdargs >= 0.1+ , filepath == 1.2.*+ , uu-parsinglib >= 2.7 hs-source-dirs: src Other-Modules: Data.Data, Data.List.Utils, Data.String.Utils, Language.LaTeX, Language.Markup, Literate.Agda,
src/Base/CLI.hs view
@@ -22,9 +22,11 @@ usage :: String usage = unlines - [ programName ++" "++ programVersion ++" - A lhs2TeX Syntax Coloring pre-processor"+ [ programName ++" "++ programVersion ++" - A lhs2TeX Syntax Colouring preprocessor" , "Consult the README file for extra information or visit:\n"- , " https://github.com/spockz/lhs2texhl"+ , " https://github.com/spockz/lhs2texhl"+ , " and "+ , " http://alessandrovermeulen.me/projects/lhs2texhl\n" , "Copyright 2010, Alessandro Vermeulen <me@alessandrovermeulen.me>" ] newCommands :: String@@ -34,7 +36,6 @@ "\\newcommand{\\lhsCHprelude}[1]{\\color{prelude}{{#1}}}", "\\newcommand{\\lhsCHkeyword}[1]{\\color{keyword}{{#1}}}", "\\newcommand{\\lhsCHconstructor}[1]{\\color{constructor}{{#1}}}",- "\\newcommand{\\lhsCHlitNumber}[1]{\\color{numeral}{{#1}}}", "\\newcommand{\\lhsCHtype}[1]{\\color{datatype}{{#1}}}", "\\newcommand{\\lhsCHsyntax}[1]{\\color{syntax}{{#1}}}", "\\newcommand{\\lhsCHclass}[1]{\\color{class}{{#1}}}",
src/Base/Common.hs view
@@ -1,4 +1,4 @@ module Base.Common where -programVersion = "0.1.4.3"+programVersion = "0.1.4.5" programName = "lhs2TeX-hl"
src/Data/String/Utils.hs view
@@ -4,21 +4,17 @@ rtrim chars inp = rtrim' inp where rtrim' "" = []- rtrim' [x] = case elem x chars of- True -> []- False -> [x]+ rtrim' [x] = if x `elem` chars then [] else [x] rtrim' (x:xs) = let tail = rtrim' xs in case tail of- [] -> case elem x chars of- True -> []- False -> [x]+ [] -> if x `elem` chars then [] else [x] xs -> x : tail ltrim :: String -> String -> String ltrim chars = ltrim' where ltrim' s = case s of [] -> []- (x:xs) -> if elem x chars+ (x:xs) -> if x `elem` chars then ltrim' xs else s
src/Literate/Haskell.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-}-module Literate.Haskell (runHaskell, mapping, fromParse) where+module Literate.Haskell (runHaskell, mapping) where import Data.List (nub) import Data.Maybe@@ -28,11 +28,11 @@ ) fp -runHaskell :: FilePath -> IO SimpleInfo+runHaskell :: FilePath -> IO (Either String SimpleInfo) runHaskell fp = do mod <- parseFile fp case mod of- (ParseOk m) -> return $ getSimpleInfo m- (ParseFailed loc err) -> error $ + (ParseOk m) -> (return . Right) (getSimpleInfo m)+ (ParseFailed loc err) -> (return . Left) $ "Parsing failed at `" ++ show loc ++ " " ++ err@@ -56,7 +56,7 @@ searchTypes _ = [] searchConDecl :: ItemQuery ConDecl-searchConDecl (ConDecl (i) _) = [Constructor $ prettyPrint i]+searchConDecl (ConDecl i _) = [Constructor $ prettyPrint i] searchConDecl (InfixConDecl _ i _) = [Constructor $ prettyPrint i] searchConDecl (RecDecl i _) = [Constructor $ prettyPrint i] @@ -71,7 +71,7 @@ searchExp _ = [] searchMat :: ItemQuery Match-searchMat (Match _ (i) _ _ _ _) = [Function $ prettyPrint i]+searchMat (Match _ i _ _ _ _) = [Function $ prettyPrint i] searchDecl :: ItemQuery Decl searchDecl (TypeSig _ names t) = case t of@@ -144,25 +144,7 @@ mtypes SimpleInfo{types} = map dp types moperators SimpleInfo{operators} = map (\ a -> (a, "\\ \\mathbin{"++ makeLatexSafe a++"}\\ ")) operators-mconstructors SimpleInfo{constructors} = map (dp) constructors-mfunctions SimpleInfo{functions } = map (dp) functions-mclasses SimpleInfo{classes} = map (dp) classes-mconstants SimpleInfo{constants} = map (dp) constants----fooz = [4, 13, 42]-douz = [4.0, 13.0, 42.0]----(<++>) :: a -> b -> a-(<++>) a b = a--tid :: Typeable a => a -> a-tid = id---fromParse (ParseOk m) = m--+mconstructors SimpleInfo{constructors} = map dp constructors+mfunctions SimpleInfo{functions } = map dp functions+mclasses SimpleInfo{classes} = map dp classes+mconstants SimpleInfo{constants} = map dp constants
src/LiterateHighlighter.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts, Rank2Types #-} module Main where import Data.List@@ -5,9 +6,17 @@ import System.Environment( getArgs ) import System.IO +import Data.Maybe (fromJust) import Language.Haskell.Exts +import Text.ParserCombinators.UU.Core+import qualified Text.ParserCombinators.UU.Core as PCC ( parse )+import Text.ParserCombinators.UU.BasicInstances hiding (input)+import Text.ParserCombinators.UU.Derived+import Text.ParserCombinators.UU.Utils++import System.FilePath ( takeDirectory ) ----------------------------- import Base.CLI@@ -18,39 +27,75 @@ import Language.Markup++ ----------------------------- main = do args <- cmdArgsRun standard-- hSetEncoding stdin utf8- hSetEncoding stdout utf8- hSetEncoding stderr utf8+ goUTF8 - case (action args) of+ case action args of ListCommands -> putStr newCommands- _ -> if (agda_mode args)+ _ -> if agda_mode args then error "Agda mode is currently not supported." else printFormatting args - where printFormat keyword seek rep = "%format " ++ seek ++ " = \" {\\lhsCH" ++ keyword ++ "{" ++ rep ++ "}}\"" - writeOutput output si mapping = - mapM_ (\(keyword, f) -> mapM_ (\ (seek,rep) -> hPutStrLn output $ printFormat keyword seek rep) + where printFormat keyword (seek, rep) = "%format " ++ seek ++ " = \" {\\lhsCH" ++ keyword ++ "{" ++ rep ++ "}}\"" + writeOutput output mapping si = + mapM_ (\(keyword, f) -> mapM_ (hPutStrLn output . printFormat keyword) (filter lhs2TeXSafe (f si)) ) mapping- printFormatting args = do hOutput <- openFile (output args) WriteMode- let writer = writeOutput hOutput- hSetEncoding hOutput utf8- mapM_ (\file -> runHaskell file- >>= (flip writer) Literate.Haskell.mapping)- (input args)+ printFormatting args = do hOutput <- openUTF8File (output args)+ let writer m (Right si) = writeOutput hOutput m si+ writer _ (Left err) = hPutStrLn stderr $ "There was an error, a file has been skipped:" ++ err++ files <- fmap (nub . concat)+ (mapM discoverFiles (input args))++ mapM_ ((writer Literate.Haskell.mapping =<<) . runHaskell)+ files hClose hOutput+ goUTF8 = do hSetEncoding stdin utf8+ hSetEncoding stdout utf8+ hSetEncoding stderr utf8+ openUTF8File fp = do hOutput <- openFile fp WriteMode+ hSetEncoding hOutput utf8+ return hOutput++discoverFiles :: FilePath -> IO [FilePath]+discoverFiles fp = do contents <- fmap (\xs -> [base ++ x | Just x <- map runPInclude (lines xs)])+ (readFile fp)+ files <- mapM discoverFiles contents+ return (nub $ fp : concat files)+ where files = undefined+ base = takeDirectory fp ++ "/"++runPInclude :: String -> Maybe String+runPInclude xs@('%':_) = runParse pInclude xs+runPInclude _ = Nothing++runParse :: Show t => Parser t -> String -> Maybe t+runParse p inp = let r@(a, errors) = PCC.parse ( (,) <$> p <*> pEnd) + (createStr (LineColPos 0 0 0) inp)+ in if null errors then Just a else Nothing+ +pInclude :: Parser FilePath+pInclude = (++ ".lhs") <$> ( pSymbol "%"+ *> pSymbol "include"+ *> pSome (pLetter <|> pDigit <|> pSym '/')+ <* pSymbol ".lhs") +isJust :: Maybe a -> Bool +isJust (Nothing) = False+isJust (Just _) = True lhs2TeXSafe :: (String, String) -> Bool lhs2TeXSafe ("()" , _) = False lhs2TeXSafe _ = True++