lhs2TeX-hl 0.1.0.9 → 0.1.1.0
raw patch · 9 files changed
+388/−52 lines, 9 files
Files
- LiterateHighlighter.hs +0/−50
- lhs2TeX-hl.cabal +6/−2
- src/Base/Cli.hs +33/−0
- src/Base/Common.hs +4/−0
- src/Language/LaTeX.hs +51/−0
- src/Literate/Agda.hs +54/−0
- src/Literate/Haskell.hs +161/−0
- src/Literate/SimpleInfo.hs +24/−0
- src/LiterateHighlighter.hs +55/−0
− LiterateHighlighter.hs
@@ -1,50 +0,0 @@-module Main where--import Data.List--import System( getArgs )-import System.IO---import Language.Haskell.Exts---------------------------------import Base.CLI-import System.Console.CmdArgs--import Literate.Agda-import Literate.Haskell -import Literate.SimpleInfo----------------------------------main = do args <- cmdArgsRun standard-- hSetEncoding stdin utf8- hSetEncoding stdout utf8- hSetEncoding stderr utf8- - hOutput <- openFile (output args) WriteMode- hSetEncoding hOutput utf8-- let writer = writeOutput hOutput- - if (agda_mode args)- then- mapM_ (\file -> runAgda file- >>= (flip writer) Literate.Agda.mapping)- (input args)- else- mapM_ (\file -> runHaskell file- >>= (flip writer) Literate.Haskell.mapping)- (input args)- - hClose hOutput- 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) - (f si)) - mapping-
lhs2TeX-hl.cabal view
@@ -1,5 +1,5 @@ Name: lhs2TeX-hl-Version: 0.1.0.9+Version: 0.1.1.0 Cabal-Version: >= 1.6 License: MIT Author: Alessandro Vermeulen <me@alessandrovermeulen.me>@@ -13,6 +13,7 @@ category: Development, Language Data-files: README examples/theme1.tex License-file: LICENSE+bug-reports: http://github.com/spockz/lhs2texhl/issues Executable lhs2TeX-hl Main-Is: LiterateHighlighter.hs@@ -21,5 +22,8 @@ , haskell-src-exts >= 1.9.3 , MissingH >= 1.1.0.3 , syb >= 0.1.0.1- , Agda >= 2.2.6 , cmdargs >= 0.1+ , Agda >= 2.2.6+ hs-source-dirs: src+ Other-Modules: Language.LaTeX, Literate.Agda, Literate.Haskell,+ Literate.SimpleInfo, Base.Cli, Base.Common
+ src/Base/Cli.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Base.CLI (ProgramOptions(..), usage, standard, module System.Console.CmdArgs) where+ +import System.Console.CmdArgs++import Base.Common++data ProgramOptions = ProgramOptions+ { agda_mode :: Bool+ , input :: [FilePath]+ , output :: FilePath+ } deriving (Show, Data, Typeable)++++usage :: String+usage = unlines + [ programName ++" "++ programVersion ++" - A lhs2TeX Syntax Coloring pre-processor"+ , "Copyright 2010, Alessandro Vermeulen <me@alessandrovermeulen.me>" ]++++-- | Standard command line options. +--++standard = cmdArgsMode $ ProgramOptions + { + agda_mode = def &= help "Run in agda-mode!" + , output = (def &= help "Output file") &= typFile+ , input = (def &= args ) + } &= summary usage++
+ src/Base/Common.hs view
@@ -0,0 +1,4 @@+module Base.Common where+ +programVersion = "0.1.1.0"+programName = "lhs2TeX-hl"
+ src/Language/LaTeX.hs view
@@ -0,0 +1,51 @@+module Language.LaTeX where++import Data.String.Utils++makeLatexSafe :: String -> String+makeLatexSafe = replace ">" "\\textgreater" + . replace "<" "\\textless"+ . replace "_" "\\_"+ . replace "\"" "\\\""+ + . replace "&" "\\&"+ . replace "#" "\\#"++{- This part is to conserve some lhs2TeX behaviour. Really shouldn't be here... -}+ . replace "=" "\\ = \\ "+ . replace "_" "\\ \\anonymous\\ "+ . replace "$" "\\ \\mathbin{\\$}\\ "+ . replace "&&" "\\ \\mathrel{\\wedge}\\ "+ . replace "||" "\\ \\mathrel{\\vee}\\ "+ . replace "<-" "\\ \\leftarrow\\ "+ . replace "->" "\\ \\to\\ "+ . replace "=>" "\\ \\Rightarrow\\ "+ . replace "==" "\\ \\equiv\\ "+ . replace "++" "\\ \\plus\\ "+ . replace "/=" "\\ \\not\\equiv\\ "+ . replace "<=" "\\ \\leq\\ "+ . replace ">=" "\\ \\geq\\ "+ . replace ">>" "\\ \\sequ\\ "+ . replace ">>=" "\\ \\bind\\ "+ . replace "=<<" "\\ \\rbind\\ "+ . replace "undefined" "\\bot\\ "+ . replace "not" "\\ \\neg "+ + + -- %format _ = "\anonymous "+ -- %format -> = "\to "+ -- %format <- = "\leftarrow "+ -- %format => = "\Rightarrow "+ -- %format \ = "\lambda "+ -- %format | = "\mid "+ + . replace "{" "\\{"+ . replace "}" "\\}"+ + . replace "\\" "\\lambda " -- argh++char :: Integer -> String+char n = "\\ \\char''" ++ show n ++"\\ "+ +dp :: String -> (String, String)+dp a = (a, makeLatexSafe a)
+ src/Literate/Agda.hs view
@@ -0,0 +1,54 @@+{-# LANGUAGE NamedFieldPuns #-}+module Literate.Agda (runAgda, mapping) where++import Data.List (nub)+import Data.Data+import Data.Generics++---+++import Agda.Syntax.Concrete+import Agda.Syntax.Literal++import Agda.Syntax.Parser+import Agda.Utils.FileName++----++import Language.LaTeX++import Literate.SimpleInfo++----++runAgda :: FilePath -> IO SimpleInfo+runAgda path = do abpath <- absolute path+ mod <- parseFile' moduleParser abpath+ return simpleinfo{ functions = []+ , operators = listOperators mod+ , literalNumbers = listLiteralNumbers mod+ }++mapping :: [(String, SimpleInfo -> [(String,String)])]+mapping = [ + ("litNumber", mnumbers)+ , ("infixoperator", moperators)+ ]+ +listOperators :: Module -> [String]+listOperators = nub . everything (++) ([] `mkQ` listOperator)+ where listOperator :: Expr -> [String]+ listOperator (OpApp _ n _) = [show n]+ listOperator (_) = []+ +listLiteralNumbers :: Module -> [String]+listLiteralNumbers = nub . everything (++) ([] `mkQ` listLiteralNumber)+ where listLiteralNumber :: Literal -> [String]+ listLiteralNumber (LitInt _ v) = [show v]+ listLiteralNumber (LitFloat _ v) = [show v]+ listLiteralNumber (_) = []+ +mnumbers SimpleInfo{literalNumbers} = map dp literalNumbers+moperators SimpleInfo{operators} = map (\ a -> (a, "\\ "++ makeLatexSafe a++"\\ ")) + operators
+ src/Literate/Haskell.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE NamedFieldPuns #-}+module Literate.Haskell (runHaskell, mapping) where++import Data.List (nub)+import Data.Data+import Data.Generics+import Language.Haskell.Exts++import Language.LaTeX+import Literate.SimpleInfo+ ++newtype M = M Module deriving (Typeable, Data)+++runHaskell :: FilePath -> IO SimpleInfo+runHaskell fp = do mod <- parseFile fp+ case mod of+ (ParseOk m) -> return $ getSimpleInfo m+ (ParseFailed loc err) -> error $ + "Parsing failed at `" + ++ show loc+ ++ " " ++ err+++{- SYB Queries -}+listTypes :: Module -> [String]+listTypes m = (map prettyPrint (collectTypes m))+ where+ collectTypes :: Module -> [QName]+ collectTypes = nub . everything (++) ([] `mkQ` getData) where+ getData :: Type -> [QName]+ getData (TyCon n) = [n]+ getData _ = []+++listLitNumbers :: Module -> [String]+listLitNumbers = nub . everything (++) ([] `mkQ` listLitNumber)+ where listLitNumber :: Literal -> [String]+ listLitNumber (Char _) = []+ listLitNumber (String _) = []+ listLitNumber (Int v) = [show v]+ listLitNumber (Frac v) = [show v]+ listLitNumber (PrimInt v) = [show v]+ listLitNumber (PrimFloat v) = [show v]+ listLitNumber (PrimDouble v) = [show v]+ listLitNumber (_) = []++listConstructors :: Module -> [String]+listConstructors = nub . everything (++) ([] `mkQ` listConstructor)+ where listConstructor :: ConDecl -> [String]+ listConstructor (ConDecl (i) _) = [prettyPrint i]+ listConstructor (InfixConDecl _ i _) = [prettyPrint i]+ listConstructor (RecDecl i _) = [prettyPrint i]++listFunctions :: Module -> [String]+listFunctions = nub . everything (++) ([] `mkQ` functionBinding `extQ` functionUse)+ where functionBinding :: Match -> [String]+ functionBinding (Match _ (i) _ _ _ _) = [prettyPrint i]+ functionUse :: Exp -> [String] + functionUse (App (Var qname) _) = [prettyPrint qname]+ functionUse _ = []+ +listOperators :: Module -> [String]+listOperators = nub . everything (++) ([] `mkQ` operatorUse)+ where operatorUse :: Exp -> [String] + operatorUse (InfixApp _ qop _) = [prettyPrint qop]+ operatorUse _ = []+++getSimpleInfo m = simpleinfo{ types = listTypes m+ , literalNumbers = listLitNumbers m+ , constructors = listConstructors m+ , functions = listFunctions m+ , operators = listOperators m+ }++++mapping :: [(String, SimpleInfo -> [(String,String)])]+mapping = [ ("syntax", syntax)+ , ("keyword", keywords)+ , ("prelude", prelude)+ , ("applicative", applicative )+ , ("type", mtypes) + , ("litNumber", mnumbers)+ , ("constructor", mconstructors)+ , ("function", mfunctions)+ , ("infixoperator", moperators)+ ]+ +mtypes :: SimpleInfo -> [(String, String)]+mtypes SimpleInfo{types} = map dp types+moperators SimpleInfo{operators} = map (\ a -> (a, "\\ "++ makeLatexSafe a++"\\ ")) + operators+mnumbers SimpleInfo{literalNumbers} = map dp literalNumbers+mconstructors SimpleInfo{constructors} = map (dp) constructors+mfunctions SimpleInfo{functions } = map (dp) functions++syntax _ = map dp [ "=", "{", "}", "(", ")", "<-", "->", "=>", ","+ ]++keywords _ = map dp [ "data", "deriving", "type", "instance", "family", "where"+ , "newtype", "if", "then", "else", "case", "of", "module"+ , "as", "hiding", "import", "let", "in", "do", "class"]++prelude SimpleInfo{functions } = map dp $+ filter ((flip elem) functions)+ ["abs" , "acos" , "acosh" , "all" , "and" , "any" , + "appendFile" , "applyM" , "asTypeOf" , "asin" , "asinh" , + "atan" , "atan2" , "atanh" , "break" , "catch" , "ceiling",+ "compare" , "concat" , "concatMap" , "const" , "cos" , + "cosh" , "curry" , "cycle" , "decodeFloat" , "div" , + "divMod" , "drop" , "dropWhile" , "elem" , "encodeFloat" , + "enumFrom" , "enumFromThen" , "enumFromThenTo" , + "enumFromTo" , "error" , "even" , "exp" , "exponent" , + "fail" , "filter" , "flip" , "floatDigits" , "floatRadix" , + "floatRange" , "floor" , "fmap" , "foldl" , "foldl1" , + "foldr" , "foldr1" , "fromEnum" , "fromInteger" , + "fromIntegral" , "fromRational" , "fst" , "gcd" , + "getChar" , "getContents" , "getLine" , "head" , "id" , + "init" , "interact" , "ioError" , "isDenormalized" , + "isIEEE" , "isInfinite" , "isNaN" , "isNegativeZero" , + "iterate" , "last" , "lcm" , "length" , "lex" , "lines" , + "log" , "logBase" , "lookup" , "map" , "mapM" , "mapM_" , + "max" , "maxBound" , "maximum" , "maybe" , "min" , + "minBound" , "minimum" , "mod" , "negate" , "not" , + "notElem" , "null" , "odd" , "or" , "otherwise" , "pi" , + "pred" , "print" , "product" , "properFraction" , + "putChar" , "putStr" , "putStrLn" , "quot" , "quotRem" , + "read" , "readFile" , "readIO" , "readList" , "readLn" , + "readParen" , "reads" , "readsPrec" , "realToFrac" , + "recip" , "rem" , "repeat" , "replicate" , "return" , + "reverse" , "round" , "scaleFloat" , "scanl" , "scanl1" , + "scanr" , "scanr1" , "seq" , "sequence" , "sequence_" , + "show" , "showChar" , "showList" , "showParen" , + "showString" , "shows" , "showsPrec" , "significand" , + "signum" , "sin" , "sinh" , "snd" , "span" , "splitAt" , + "sqrt" , "subtract" , "succ" , "sum" , "tail" , "take" , + "takeWhile" , "tan" , "tanh" , "toEnum" , "toInteger" , + "toRational" , "truncate" , "uncurry" , + "unlines" , "until" , "unwords" , "unzip" , "unzip3" , + "userError" , "words" , "writeFile" , "zip" , "zip3" , + "zipWith" , "zipWith3", "$"]+++applicative _ = []++fooz = [4, 13, 42]+douz = [4.0, 13.0, 42.0]++++(<++>) :: a -> b -> a+(<++>) a b = a+++fromParse (ParseOk m) = m++
+ src/Literate/SimpleInfo.hs view
@@ -0,0 +1,24 @@+module Literate.SimpleInfo where++data SimpleInfo = SimpleInfo {+ fileName :: String,+ moduleName :: String,+ types :: [String],+ constructors :: [String],+ functions :: [String],+ operators :: [String],+ literalNumbers :: [String],+ literalChars :: [Char],+ literalStrings :: [String]+} deriving Show++simpleinfo = SimpleInfo{ fileName = ""+ , moduleName = ""+ , types = []+ , constructors = []+ , functions = []+ , operators = []+ , literalNumbers = []+ , literalChars = []+ , literalStrings = []+ }
+ src/LiterateHighlighter.hs view
@@ -0,0 +1,55 @@+module Main where++import Data.List++import System( getArgs )+import System.IO+++import Language.Haskell.Exts++-----------------------------++import Base.CLI+import System.Console.CmdArgs++import Literate.Agda+import Literate.Haskell +import Literate.SimpleInfo++-----------------------------+++main = do args <- cmdArgsRun standard++ hSetEncoding stdin utf8+ hSetEncoding stdout utf8+ hSetEncoding stderr utf8+ + hOutput <- openFile (output args) WriteMode+ hSetEncoding hOutput utf8++ let writer = writeOutput hOutput+ + if (agda_mode args)+ then+ mapM_ (\file -> runAgda file+ >>= (flip writer) Literate.Agda.mapping)+ (input args)+ else+ mapM_ (\file -> runHaskell file+ >>= (flip writer) Literate.Haskell.mapping)+ (input args)+ + hClose hOutput+ 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) + (filter lhs2TeXSafe (f si))+ ) + mapping+ +lhs2TeXSafe :: (String, String) -> Bool+lhs2TeXSafe ("()" , _) = False+lhs2TeXSafe _ = True+