lhs2TeX-hl 0.1.3.3 → 0.1.4.0
raw patch · 7 files changed
+164/−155 lines, 7 files
Files
- README.asciidoc +24/−9
- lhs2TeX-hl.cabal +1/−1
- src/Base/CLI.hs +25/−5
- src/Base/Common.hs +1/−1
- src/Literate/Haskell.hs +94/−121
- src/Literate/SimpleInfo.hs +4/−2
- src/LiterateHighlighter.hs +15/−16
README.asciidoc view
@@ -85,18 +85,33 @@ * If a identifier names in a sequence of digits, the digits will be typeset in subscript.-* If you have trailing underscores they will be omitted in the typesetting.- This is so you can do something like:-- ------ data Foo = Foo_ a;- ------ +* If you have trailing underscores they will be omitted in the typesetting. This+ is so you can do something like in <<Automatic_underscore_removal, Automatic+ removal of trailing underscores>>. And have Foo highlighted as a type constructor, and Foo_ highlighted as `Foo' in a data constructor colour. -* If there are underscores in the middle of your identifier, everything- after the underscores will be typeset in subscript.+* If there are underscores in the middle of your identifier, everything after+ the underscores will be typeset in subscript as in+ <<Automatic_subscript_generation, Automatic subscript generation>>.+ +.Automatic removal of trailing underscores+[[Automatic_underscore_removal]]+[source,haskell]+-----+data Foo = Foo_ a;+-----++.Automatic subscript generation+[[Automatic_subscript_generation]]+[source,haskell]+----+foo_1 = undefined+-- Get's transformed into+foo₁ = undefined+----++ THEMES ------
lhs2TeX-hl.cabal view
@@ -1,5 +1,5 @@ Name: lhs2TeX-hl-Version: 0.1.3.3+Version: 0.1.4.0 Cabal-Version: >= 1.6 License: MIT Author: Alessandro Vermeulen <me@alessandrovermeulen.me>
src/Base/CLI.hs view
@@ -1,12 +1,19 @@ {-# LANGUAGE DeriveDataTypeable #-}-module Base.CLI (ProgramOptions(..), usage, standard, module System.Console.CmdArgs) where+module Base.CLI (ProgramOptions(..), Action(..), usage, newCommands, standard, module System.Console.CmdArgs) where import System.Console.CmdArgs import Base.Common +data Action = Format | ListCommands+ deriving (Show, Typeable, Data)++instance Default Action where+ def = Format+ data ProgramOptions = ProgramOptions { agda_mode :: Bool+ , action :: Action , input :: [FilePath] , output :: FilePath } deriving (Show, Data, Typeable)@@ -20,16 +27,29 @@ , " https://github.com/spockz/lhs2texhl" , "Copyright 2010, Alessandro Vermeulen <me@alessandrovermeulen.me>" ] -+newCommands :: String+newCommands = unlines [+ "\\newcommand{\\lhsCHfunction}[1]{\\color{infixoperator}{{#1}}}",+ "\\newcommand{\\lhsCHinfixoperator}[1]{\\color{infixoperator}{{#1}}}",+ "\\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}}}",+ "\\newcommand{\\lhsCHconstant}[1]{\\color{prelude}{{#1}}}"+ ] -- | Standard command line options. -- standard = cmdArgsMode $ ProgramOptions { - agda_mode = def &= help "Run in agda-mode!" - , output = (def &= help "Output file") &= typFile- , input = (def &= args ) + agda_mode = def &= help "Run in agda-mode!"+ , action = (def &= help "What should the program do? Format|ListCommands.") &= typ "Action"+ , output = (def &= help "Output file") &= typFile+ , input = (def &= args ) } &= summary usage
src/Base/Common.hs view
@@ -1,4 +1,4 @@ module Base.Common where -programVersion = "0.1.3.2"+programVersion = "0.1.4.0" programName = "lhs2TeX-hl"
src/Literate/Haskell.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NamedFieldPuns #-}-module Literate.Haskell (runHaskell, mapping, listClasses, fromParse) where+{-# LANGUAGE RankNTypes #-}+module Literate.Haskell (runHaskell, mapping, fromParse) where import Data.List (nub) import Data.Maybe@@ -14,6 +15,13 @@ newtype M = M Module deriving (Typeable, Data) +type ItemQuery a = a -> [Item]++newtype ConstructorSearch = ConstructorSearch Module deriving (Typeable, Show)+newtype FunctionSearch = FunctionSearch Module deriving (Typeable, Show)+newtype OperatorSearch = OperatorSearch Module deriving (Typeable, Show)+newtype ClassSearch = ClassSearch Module deriving (Typeable, Show)+ parseFile fp = parseFileWithMode (defaultParseMode { fixities = Just baseFixities , parseFilename = fp } @@ -28,97 +36,108 @@ "Parsing failed at `" ++ show loc ++ " " ++ err+ +collect :: Module -> [Item]+collect = nub . everything (++) ([] `mkQ` searchTypes+ `extQ` searchConDecl+ `extQ` searchPat+ `extQ` searchExp+ `extQ` searchMat+ `extQ` searchDecl+ `extQ` searchDeriving+ `extQ` searchAsst)+ + {- 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 _ = []- -- getType :: Decl -> [QName]- -- getType (DataDecl _ _ _ _ decl _ _) = let f (Ident n) = [n]- -- f _ = []- -- in f decl- -- - -- getType _ = []+searchTypes :: ItemQuery Type+searchTypes (TyCon n) = [Type (prettyPrint n)]+searchTypes _ = [] -listConstructors :: Module -> [String]-listConstructors = nub . everything (++) ([] `mkQ` listConstructor - `extQ` listConstructorPat - `extQ` listConstructorUse)- where listConstructor :: ConDecl -> [String]- listConstructor (ConDecl (i) _) = [prettyPrint i]- listConstructor (InfixConDecl _ i _) = [prettyPrint i]- listConstructor (RecDecl i _) = [prettyPrint i]- listConstructorPat :: Pat -> [String]- listConstructorPat (PApp i _) = [prettyPrint i]- listConstructorPat _ = []- listConstructorUse :: Exp -> [String]- listConstructorUse (Con i) = [prettyPrint i]- listConstructorUse _ = []+searchConDecl :: ItemQuery ConDecl+searchConDecl (ConDecl (i) _) = [Constructor $ prettyPrint i]+searchConDecl (InfixConDecl _ i _) = [Constructor $ prettyPrint i]+searchConDecl (RecDecl i _) = [Constructor $ prettyPrint i] -listFunctions :: Module -> [String]-listFunctions = nub . everything (++) ([] `mkQ` functionBinding - `extQ` functionUse - `extQ` functionTypeSig)- where functionBinding :: Match -> [String]- functionBinding (Match _ (i) _ _ _ _) = [prettyPrint i]- functionUse :: Exp -> [String] - functionUse (App (Var qname) _) = [prettyPrint qname]- functionUse _ = []- functionTypeSig :: Decl -> [String]- functionTypeSig (TypeSig _ names t) = case t of- TyParen (TyFun _ _) -> map nameToString names- TyFun _ _ -> map nameToString names- _ -> []- functionTypeSig _ = []- nameToString :: Name -> String- nameToString (Ident s) = s- nameToString (Symbol s) = s+searchPat :: ItemQuery Pat+searchPat (PApp i _) = [Constructor $ prettyPrint i]+searchPat _ = []++searchExp :: ItemQuery Exp+searchExp (Con i) = [Constructor $ prettyPrint i]+searchExp (App (Var qname) _) = [Function $ prettyPrint qname]+searchExp (InfixApp _ qop _) = [Operator $ prettyPrint qop]+searchExp _ = []++searchMat :: ItemQuery Match+searchMat (Match _ (i) _ _ _ _) = [Function $ prettyPrint i]++searchDecl :: ItemQuery Decl+searchDecl (TypeSig _ names t) = case t of+ TyParen (TyFun _ _) -> namesToFunction names+ TyFun _ _ -> namesToFunction names+ TyForall _ _ t -> case t of + TyParen (TyFun _ _) -> namesToFunction names+ TyFun _ _ -> namesToFunction names+ _ -> namesToConstant names+ _ -> namesToConstant names+ where nameToString :: (String -> Item) -> Name -> Item+ nameToString f (Ident s) = f s+ nameToString f (Symbol s) = f s+ namesToFunction = map (nameToString Function)+ namesToConstant = map (nameToString Constant) + + + + + +searchDecl (ClassDecl _ _ name _ _ _) = [Class $ prettyPrint name]+searchDecl _ = []+ -listOperators :: Module -> [String]-listOperators = nub . everything (++) ([] `mkQ` operatorUse)- where operatorUse :: Exp -> [String] - operatorUse (InfixApp _ qop _) = [prettyPrint qop]- operatorUse _ = [] -listClasses :: Module -> [String]-listClasses = nub . everything (++) ([] `mkQ` listClassDeriving- `extQ` listClassDecl- `extQ` listClassContext)- where listClassDeriving :: Deriving -> [String] - listClassDeriving (name , _) = [prettyPrint name]- listClassDecl :: Decl -> [String]- listClassDecl (ClassDecl _ _ name _ _ _) = [prettyPrint name]- listClassDecl _ = []- listClassContext :: Asst -> [String]- listClassContext (ClassA name _) = [prettyPrint name]- listClassContext _ = [] +searchDeriving :: ItemQuery Deriving+searchDeriving (name , _) = [Class $ prettyPrint name] -getSimpleInfo m = simpleinfo{ types = listTypes m- , constructors = listConstructors m- , functions = listFunctions m- , operators = listOperators m- , classes = listClasses m+searchAsst :: ItemQuery Asst+searchAsst (ClassA name _) = [Class $ prettyPrint name]+searchAsst _ = []+++getSimpleInfo m = simpleinfo{ types = f isT+ , constructors = f isCo+ , functions = f isF+ , operators = f isO+ , classes = f isCl+ , constants = f isConst }+ where f p = map show (filter p collection)+ isT (Type _) = True+ isT _ = False+ isCo (Constructor _) = True+ isCo _ = False+ isF (Function _) = True+ isF _ = False+ isO (Operator _) = True+ isO _ = False+ isCl (Class _) = True+ isCl _ = False+ isConst (Constant _) = True+ isConst _ = False+ collection = collect m mapping :: [(String, SimpleInfo -> [(String,String)])]-mapping = [ ("syntax", syntax)- , ("keyword", keywords)- , ("prelude", prelude)- -- , ("applicative", applicative )- , ("type", mtypes) +mapping = [ + ("type", mtypes) , ("constructor", mconstructors) , ("function", mfunctions) , ("infixoperator", moperators) , ("class", mclasses)+ , ("constant", mconstants) ] mtypes :: SimpleInfo -> [(String, String)]@@ -128,55 +147,9 @@ mconstructors SimpleInfo{constructors} = map (dp) constructors mfunctions SimpleInfo{functions } = map (dp) functions mclasses SimpleInfo{classes} = map (dp) classes--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", "$"]+mconstants SimpleInfo{constants} = map (dp) constants -applicative _ = [] fooz = [4, 13, 42] douz = [4.0, 13.0, 42.0]
src/Literate/SimpleInfo.hs view
@@ -7,8 +7,8 @@ constructors :: [String], functions :: [String], operators :: [String],- classes :: [String]-+ classes :: [String],+ constants :: [String] } deriving Show @@ -19,4 +19,6 @@ , functions = [] , operators = [] , classes = []+ , constants = [] }+
src/LiterateHighlighter.hs view
@@ -28,29 +28,28 @@ hSetEncoding stdout utf8 hSetEncoding stderr utf8 - hOutput <- openFile (output args) WriteMode- hSetEncoding hOutput utf8+ case (action args) of+ ListCommands -> putStr newCommands+ _ -> if (agda_mode args)+ then+ error "Agda mode is currently not supported."+ else + printFormatting args - let writer = writeOutput hOutput- - if (agda_mode args)- then- error "Agda mode is currently not supported."- -- 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+ 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)+ hClose hOutput+ lhs2TeXSafe :: (String, String) -> Bool lhs2TeXSafe ("()" , _) = False