haskintex 0.3.0.0 → 0.3.1.0
raw patch · 5 files changed
+437/−417 lines, 5 filesdep +haskintexdep +parsecdep −attoparsecdep ~HaTeXdep ~basedep ~hint
Dependencies added: haskintex, parsec
Dependencies removed: attoparsec
Dependency ranges changed: HaTeX, base, hint, process, text
Files
- Haskintex.hs +409/−0
- Main.hs +0/−404
- examples/fact.htex +0/−0
- haskintex.cabal +20/−13
- main/Main.hs +8/−0
+ Haskintex.hs view
@@ -0,0 +1,409 @@++{-# LANGUAGE OverloadedStrings #-}++module Haskintex (haskintex) where++-- System+import System.Process (readProcess)+import System.FilePath+import System.Directory+import System.IO (hFlush,stdout)+-- Text+import Data.Text (pack,unpack)+import qualified Data.Text as T+import qualified Data.Text.IO as T+-- Parser+-- import Data.Attoparsec.Text+import Text.Parsec hiding (many)+import Text.Parsec.Text+-- Transformers+import Control.Monad (when,unless)+import Control.Monad.Trans.Class+import Control.Monad.Trans.Reader+-- LaTeX+import Text.LaTeX hiding (version)+import Text.LaTeX.Base.Syntax+-- Utils+import Control.Applicative+import Data.Foldable (foldMap)+-- Paths+import Paths_haskintex+import Data.Version (showVersion)+-- Lists+import Data.List (intersperse)+-- GHC+import Language.Haskell.Interpreter++-- Syntax++-- | The 'Syntax' datatype describes how haskintex see a LaTeX+-- file. When haskintex processes an input file, it parsers+-- to this structure. It differentiates between these parts:+--+-- * writehaskell environments (WriteHaskell), either marked+-- visible or not.+--+-- * Haskell expression of type 'LaTeX' (InsertHaTeX).+-- See the HaTeX package for details about this type.+--+-- * evalhaskell commands and environments (EvalHaskell).+--+-- * Anything else (WriteLaTeX).+--+data Syntax =+ WriteLaTeX Text+ | WriteHaskell Bool Text -- False for Hidden, True for Visible+ | InsertHaTeX Text+ | EvalHaskell Bool Text -- False for Command, True for Environment+ | Sequence [Syntax]+ deriving Show -- Show instance for debugging.++-- PARSING++parseSyntax :: Bool -> Parser Syntax+parseSyntax v = do+ s <- fmap Sequence $ many $ choice $ fmap try [ p_writehaskell v, p_inserthatex, p_evalhaskell, p_writelatex ]+ eof+ return s++p_writehaskell :: Bool -> Parser Syntax+p_writehaskell v = do+ _ <- string "\\begin{writehaskell}"+ b <- choice $ fmap try [ string "[hidden]" >> return False+ , string "[visible]" >> return True+ , return v ] -- When no option is given, take the default.+ h <- manyTill anyChar $ try $ string "\\end{writehaskell}"+ return $ WriteHaskell b $ pack h++p_inserthatex :: Parser Syntax+p_inserthatex = do+ _ <- string "\\hatex{"+ h <- p_haskell 0+ return $ InsertHaTeX $ pack h++p_evalhaskell :: Parser Syntax+p_evalhaskell = choice $ fmap try [ p_evalhaskellenv, p_evalhaskellcomm ]++p_evalhaskellenv :: Parser Syntax+p_evalhaskellenv = do+ _ <- string "\\begin{evalhaskell}"+ h <- manyTill anyChar $ try $ string "\\end{evalhaskell}"+ return $ EvalHaskell True $ pack h++p_evalhaskellcomm :: Parser Syntax+p_evalhaskellcomm = do+ _ <- string "\\evalhaskell{"+ h <- p_haskell 0+ return $ EvalHaskell False $ pack h++p_haskell :: Int -> Parser String+p_haskell n = choice [+ do _ <- char '{'+ ('{':) <$> p_haskell (n+1)+ , do _ <- char '}'+ if n == 0+ then return []+ else ('}':) <$> p_haskell (n-1)+ , do _ <- char '\"'+ liftA2 (++) (('\"':) <$> p_string) (p_haskell n)+ , try (string "'{'") >> return "'{'"+ , try (string "'}'") >> return "'}'"+ , liftA2 (:) anyChar (p_haskell n)+ ]++p_string :: Parser String+p_string = choice [+ try $ liftA2 (++) (char '\\' >> char '\"' >> return "\\\"") p_string+ , liftA2 (:) (char '\"') (return [])+ , liftA2 (:) anyChar p_string+ ]++p_writelatex :: Parser Syntax+p_writelatex = (WriteLaTeX . pack) <$>+ many1 (p_other >>= \b -> if b then anyChar else fail "stop write latex")+ where+ p_other =+ choice $ fmap (try . lookAhead)+ [ string "\\begin{writehaskell}" >> return False -- starts p_writehaskell+ , string "\\hatex" >> return False -- starts p_inserthatex+ , string "\\begin{evalhaskell}" >> return False -- starts p_evalhaskellenv+ , string "\\evalhaskell" >> return False -- starts p_evalhaskellcomm+ , return True+ ]++-- PASS 1: Extract code from processed Syntax.++extractCode :: Syntax -> Text+extractCode (WriteHaskell _ t) = t+extractCode (Sequence xs) = foldMap extractCode xs+extractCode _ = mempty++-- PASS 2: Evaluate Haskell expressions from processed Syntax.++evalCode :: String -- ^ Auxiliary module name+ -> Bool -- ^ Is manual flag on?+ -> Bool -- ^ Is lhs2tex flag on?+ -> Syntax -> Haskintex Text+evalCode modName mFlag lhsFlag = go+ where+ go (WriteLaTeX t) = return t+ go (WriteHaskell b t) =+ let f :: Text -> LaTeX+ f x | not b = mempty+ | mFlag = raw x+ | lhsFlag = TeXEnv "code" [] $ raw x+ | otherwise = verbatim x+ in return $ render $ f t+ go (InsertHaTeX t) = do+ let e = unpack $ T.strip t+ int = do+ loadModules [modName]+ setTopLevelModules [modName]+ setImports ["Prelude"]+ interpret e (as :: LaTeX)+ outputStr $ "Evaluation (LaTeX): " ++ e+ r <- runInterpreter int+ case r of+ Left err -> do+ outputStr $ "Warning: Error while evaluating the expression.\n"+ ++ errorString err+ return mempty+ Right l -> return $ render l+ go (EvalHaskell env t) =+ let f :: Text -> LaTeX+ f x | mFlag = raw x -- Manual flag overrides lhs2tex flag behavior+ | env && lhsFlag = TeXEnv "code" [] $ raw x+ | lhsFlag = raw $ "|" <> x <> "|"+ | env = verbatim $ layout x+ | otherwise = verb x+ in (render . f . pack) <$> ghc modName t+ go (Sequence xs) = mconcat <$> mapM go xs++ghc :: String -> Text -> Haskintex String+ghc modName e = do+ let e' = unpack $ T.strip e+ outputStr $ "Evaluation: " ++ e'+ lift $ init <$> readProcess "ghc" [ "-e", e', modName ++ ".hs" ] []++maxLineLength :: Int+maxLineLength = 60++-- | Break lines longer than 'maxLineLenght'.+layout :: Text -> Text+layout = T.unlines . go . T.lines+ where+ go [] = []+ go (t:ts) =+ if T.length t > maxLineLength+ then let (l,r) = T.splitAt maxLineLength t+ in l : go (r:ts)+ else t : go ts++-- Errors++errorString :: InterpreterError -> String+errorString (UnknownError e) = "Unknown error: " ++ e+errorString (WontCompile es) = "Compiler error:\n" ++ init (unlines $ fmap errMsg es)+errorString (NotAllowed e) = "Not allowed:" ++ e+errorString (GhcException e) = "GHC exception: " ++ e++-- Configuration++data Conf = Conf+ { keepFlag :: Bool+ , visibleFlag :: Bool+ , verboseFlag :: Bool+ , manualFlag :: Bool+ , helpFlag :: Bool+ , lhs2texFlag :: Bool+ , stdoutFlag :: Bool+ , overwriteFlag :: Bool+ , unknownFlags :: [String]+ , inputs :: [FilePath]+ }++supportedFlags :: [(String,Conf -> Bool)]+supportedFlags =+ [ ("keep" , keepFlag)+ , ("visible" , visibleFlag)+ , ("verbose" , verboseFlag)+ , ("manual" , manualFlag)+ , ("help" , helpFlag)+ , ("lhs2tex" , lhs2texFlag)+ , ("stdout" , stdoutFlag)+ , ("overwrite" , overwriteFlag)+ ]++readConf :: [String] -> Conf+readConf = go $ Conf False False False False False False False False [] []+ where+ go c [] = c+ go c (x:xs) =+ case x of+ -- Arguments starting with '-' are considered a flag.+ ('-':flag) ->+ case flag of+ "keep" -> go (c {keepFlag = True}) xs+ "visible" -> go (c {visibleFlag = True}) xs+ "verbose" -> go (c {verboseFlag = True}) xs+ "manual" -> go (c {manualFlag = True}) xs+ "help" -> go (c {helpFlag = True}) xs+ "lhs2tex" -> go (c {lhs2texFlag = True}) xs+ "stdout" -> go (c {stdoutFlag = True}) xs+ "overwrite" -> go (c {overwriteFlag = True}) xs+ _ -> go (c {unknownFlags = unknownFlags c ++ [flag]}) xs+ -- Otherwise, an input file.+ _ -> go (c {inputs = inputs c ++ [x]}) xs++-- Haskintex++type Haskintex = ReaderT Conf IO++outputStr :: String -> Haskintex ()+outputStr str = do+ b <- verboseFlag <$> ask+ when b $ lift $ putStrLn str++haskintex :: [String] -> IO ()+haskintex = runReaderT haskintexmain . readConf++haskintexmain :: Haskintex ()+haskintexmain = do+ flags <- ask+ if -- If the help flag is passed, ignore everything else+ -- and just print the help.+ helpFlag flags+ then lift $ putStr help+ else let xs = inputs flags+ in if null xs+ then lift $ putStr noFiles+ else mapM_ haskintexFile xs++commas :: [String] -> String+commas = concat . intersperse ", "++showEnabledFlags :: Haskintex ()+showEnabledFlags = do+ c <- ask+ outputStr $ "Enabled flags: "+ ++ commas (foldr (\(str,f) xs -> if f c then str : xs else xs) [] supportedFlags)+ ++ "."++reportWarnings :: Haskintex ()+reportWarnings = do+ -- Combination of manual and lhs2tex flags.+ manFlag <- manualFlag <$> ask+ lhsFlag <- lhs2texFlag <$> ask+ when (manFlag && lhsFlag) $+ outputStr "Warning: lhs2tex flag is useless in presence of manual flag."++haskintexFile :: FilePath -> Haskintex ()+haskintexFile fp_ = do+ -- If the given file does not exist, try adding '.htex'.+ b <- lift $ doesFileExist fp_+ let fp = if b then fp_ else fp_ ++ ".htex"+ -- Report enabled flags+ showEnabledFlags+ -- Warnings+ reportWarnings+ -- Other unknown flags passed.+ uFlags <- unknownFlags <$> ask+ unless (null uFlags) $+ outputStr $ "Unsupported flags: " ++ commas uFlags ++ "."+ -- File parsing.+ outputStr $ "Reading " ++ fp ++ "..."+ vFlag <- visibleFlag <$> ask+ t <- lift $ T.readFile fp+ -- case parseOnly (parseSyntax vFlag) t of+ -- Left err -> outputStr $ "Reading of " ++ fp ++ " failed: " ++ err+ case parse (parseSyntax vFlag) fp t of+ Left err -> outputStr $ "Reading of " ++ fp ++ " failed:\n" ++ show err+ Right s -> do+ -- First pass: Create haskell source from the code obtained with 'extractCode'.+ let modName = ("Haskintex_" ++) $ dropExtension $ takeFileName fp+ outputStr $ "Creating Haskell source file " ++ modName ++ ".hs..."+ let hs = extractCode s+ moduleHeader = pack $ "module " ++ modName ++ " where\n\n"+ lift $ T.writeFile (modName ++ ".hs") $ moduleHeader <> hs+ -- Second pass: Evaluate expressions using 'evalCode'.+ outputStr $ "Evaluating expressions in " ++ fp ++ "..."+ mFlag <- manualFlag <$> ask+ lhsFlag <- lhs2texFlag <$> ask+ l <- evalCode modName mFlag lhsFlag s+ -- Write final output.+ let fp' = dropExtension (takeFileName fp) ++ ".tex"+ writeit = do outputStr $ "Writing final file at " ++ fp' ++ "..."+ lift $ T.writeFile fp' l+ outFlag <- stdoutFlag <$> ask+ overFlag <- overwriteFlag <$> ask+ nonew <- lift $ doesFileExist fp'+ let finalOutput+ | outFlag = do outputStr "Sending final output to stdout..."+ lift $ T.putStr l+ | overFlag = writeit+ | nonew = do lift $ putStr $ "File " ++ fp' ++ " already exists. Overwrite?"+ ++ " (use -overwrite to overwrite by default) "+ lift $ hFlush stdout -- To immediately show the text on Windows systems.+ resp <- lift getLine+ if resp `elem` ["","y","yes"]+ then writeit+ else outputStr "No file was written."+ | otherwise = writeit+ finalOutput+ -- If the keep flag is not set, remove the haskell source file.+ kFlag <- keepFlag <$> ask+ unless kFlag $ do+ outputStr $ "Removing Haskell source file " ++ modName ++ ".hs "+ ++ "(use -keep to avoid this)..."+ lift $ removeFile $ modName ++ ".hs"+ -- End.+ outputStr $ "End of processing of file " ++ fp ++ "."++-- MESSAGES++help :: String+help = unlines [+ "You are using haskintex version " ++ showVersion version ++ "."+ , "http://daniel-diaz.github.io/projects/haskintex"+ , ""+ , "Usage and flags:"+ , "Any argument passed to haskintex that starts with '-' will be considered"+ , "a flag. Otherwise, it will be considered an input file. Every input file"+ , "will be processed with the same set of flags, which will include all the"+ , "flags passed in the call. This is the list of flags supported by haskintex:"+ , ""+ , " -keep haskintex creates an intermmediate Haskell file before"+ , " evaluating any expressions. By default, this file is "+ , " eliminated after processing the file. Pass this flag to"+ , " keep the file."+ , ""+ , " -visible By default, code written inside a writehaskell environment"+ , " is not shown in the LaTeX output. This flag changes the"+ , " default."+ , ""+ , " -verbose If this flag is enabled, haskintex will print information"+ , " about its own execution while running."+ , ""+ , " -manual By default, Haskell expressions, either from writehaskell "+ , " or evalhaskell, appear in the LaTeX output inside verb or"+ , " verbatim declarations. If this flag is passed, neither verb"+ , " nor verbatim will be used. The code will be written as text "+ , " as it is. The user will decide how to handle it."+ , ""+ , " -help This flags cancels any other flag or input file and makes"+ , " the program simply show this help message."+ , ""+ , " -stdout Instead of writing the output to a file, send it to the"+ , " standard output stream (stdout)."+ , ""+ , " -lhs2tex Instead of using verb or verbatim declarations, format the"+ , " output using the syntax accepted by lhs2TeX."+ , ""+ , " -overwrite Overwrite the output file if it already exists. If this flag"+ , " is not set, the program will ask before overwriting."+ , ""+ , "Any unsupported flag will be ignored."+ ]++noFiles :: String+noFiles = "No input file given.\n"
− Main.hs
@@ -1,404 +0,0 @@--{-# LANGUAGE OverloadedStrings #-}--module Main (main) where---- System-import System.Process (readProcess)-import System.Environment (getArgs)-import System.FilePath-import System.Directory-import System.IO (hFlush,stdout)--- Text-import Data.Text (pack,unpack)-import qualified Data.Text as T-import qualified Data.Text.IO as T--- Parser-import Data.Attoparsec.Text--- Transformers-import Control.Monad (when,unless)-import Control.Monad.Trans.Class-import Control.Monad.Trans.Reader--- LaTeX-import Text.LaTeX hiding (version)-import Text.LaTeX.Base.Syntax--- Utils-import Control.Applicative-import Data.Foldable (foldMap)--- Paths-import Paths_haskintex-import Data.Version (showVersion)--- Lists-import Data.List (intersperse)--- GHC-import Language.Haskell.Interpreter---- Syntax---- | The 'Syntax' datatype describes how haskintex see a LaTeX--- file. When haskintex processes an input file, it parsers--- to this structure. It differentiates between these parts:------ * writehaskell environments (WriteHaskell), either marked--- visible or not.------ * Haskell expression of type 'LaTeX' (InsertHaTeX).--- See the HaTeX package for details about this type.------ * evalhaskell commands and environments (EvalHaskell).------ * Anything else (WriteLaTeX).----data Syntax =- WriteLaTeX Text- | WriteHaskell Bool Text -- False for Hidden, True for Visible- | InsertHaTeX Text- | EvalHaskell Bool Text -- False for Command, True for Environment- | Sequence [Syntax]- deriving Show -- Show instance for debugging.---- Parsing--parseSyntax :: Bool -> Parser Syntax-parseSyntax v = fmap Sequence $ many $ choice [ p_writehaskell v, p_inserthatex, p_evalhaskell, p_writelatex ]--p_writehaskell :: Bool -> Parser Syntax-p_writehaskell v = do- _ <- string "\\begin{writehaskell}"- b <- choice [ string "[hidden]" >> return False- , string "[visible]" >> return True- , return v ] -- When no option is given, take the default.- h <- manyTill anyChar $ string "\\end{writehaskell}"- return $ WriteHaskell b $ pack h--p_inserthatex :: Parser Syntax-p_inserthatex = do- _ <- string "\\hatex{"- h <- p_haskell 0- return $ InsertHaTeX $ pack h--p_evalhaskell :: Parser Syntax-p_evalhaskell = choice [ p_evalhaskellenv, p_evalhaskellcomm ]--p_evalhaskellenv :: Parser Syntax-p_evalhaskellenv = do- _ <- string "\\begin{evalhaskell}"- h <- manyTill anyChar $ string "\\end{evalhaskell}"- return $ EvalHaskell True $ pack h--p_evalhaskellcomm :: Parser Syntax-p_evalhaskellcomm = do- _ <- string "\\evalhaskell{"- h <- p_haskell 0- return $ EvalHaskell False $ pack h--p_haskell :: Int -> Parser String-p_haskell n = choice [- do _ <- char '{'- ('{':) <$> p_haskell (n+1)- , do _ <- char '}'- if n == 0- then return []- else ('}':) <$> p_haskell (n-1)- , do _ <- char '\"'- liftA2 (++) (('\"':) <$> p_string) (p_haskell n)- , string "'{'" >> return "'{'"- , string "'}'" >> return "'}'"- , liftA2 (:) anyChar (p_haskell n)- ]--p_string :: Parser String-p_string = choice [- liftA2 (++) (char '\\' >> char '\"' >> return "\\\"") p_string- , liftA2 (:) (char '\"') (return [])- , liftA2 (:) anyChar p_string- ]--p_writelatex :: Parser Syntax-p_writelatex = (WriteLaTeX . pack) <$>- many1 (p_other >>= \b -> if b then anyChar else fail "stop write latex")- where- p_other =- choice [ string "\\begin{writehaskell}" >> return False -- starts p_writehaskell- , string "\\hatex" >> return False -- starts p_inserthatex- , string "\\begin{evalhaskell}" >> return False -- starts p_evalhaskellenv- , string "\\evalhaskell" >> return False -- starts p_evalhaskellcomm- , return True- ]---- PASS 1: Extract code from processed Syntax.--extractCode :: Syntax -> Text-extractCode (WriteHaskell _ t) = t-extractCode (Sequence xs) = foldMap extractCode xs-extractCode _ = mempty---- PASS 2: Evaluate Haskell expressions from processed Syntax.--evalCode :: String -- ^ Auxiliary module name- -> Bool -- ^ Is manual flag on?- -> Bool -- ^ Is lhs2tex flag on?- -> Syntax -> Haskintex Text-evalCode modName mFlag lhsFlag = go- where- go (WriteLaTeX t) = return t- go (WriteHaskell b t) =- let f :: Text -> LaTeX- f x | not b = mempty- | mFlag = raw x- | lhsFlag = TeXEnv "code" [] $ raw x- | otherwise = verbatim x- in return $ render $ f t- go (InsertHaTeX t) = do- let e = unpack $ T.strip t- int = do- loadModules [modName]- setTopLevelModules [modName]- setImports ["Prelude"]- interpret e (as :: LaTeX)- outputStr $ "Evaluation (LaTeX): " ++ e- r <- runInterpreter int- case r of- Left err -> do- outputStr $ "Warning: Error while evaluating the expression.\n"- ++ errorString err- return mempty- Right l -> return $ render l- go (EvalHaskell env t) =- let f :: Text -> LaTeX- f x | mFlag = raw x -- Manual flag overrides lhs2tex flag behavior- | env && lhsFlag = TeXEnv "code" [] $ raw x- | lhsFlag = raw $ "|" <> x <> "|"- | env = verbatim $ layout x- | otherwise = verb x- in (render . f . pack) <$> ghc modName t- go (Sequence xs) = mconcat <$> mapM go xs--ghc :: String -> Text -> Haskintex String-ghc modName e = do- let e' = unpack $ T.strip e- outputStr $ "Evaluation: " ++ e'- lift $ init <$> readProcess "ghc" [ "-e", e', modName ++ ".hs" ] []--maxLineLength :: Int-maxLineLength = 60---- | Break lines longer than 'maxLineLenght'.-layout :: Text -> Text-layout = T.unlines . go . T.lines- where- go [] = []- go (t:ts) =- if T.length t > maxLineLength- then let (l,r) = T.splitAt maxLineLength t- in l : go (r:ts)- else t : go ts---- Errors--errorString :: InterpreterError -> String-errorString (UnknownError e) = "Unknown error: " ++ e-errorString (WontCompile es) = "Compiler error:\n" ++ init (unlines $ fmap errMsg es)-errorString (NotAllowed e) = "Not allowed:" ++ e-errorString (GhcException e) = "GHC exception: " ++ e---- Configuration--data Conf = Conf- { keepFlag :: Bool- , visibleFlag :: Bool- , verboseFlag :: Bool- , manualFlag :: Bool- , helpFlag :: Bool- , lhs2texFlag :: Bool- , stdoutFlag :: Bool- , overwriteFlag :: Bool- , unknownFlags :: [String]- , inputs :: [FilePath]- }--supportedFlags :: [(String,Conf -> Bool)]-supportedFlags =- [ ("keep" , keepFlag)- , ("visible" , visibleFlag)- , ("verbose" , verboseFlag)- , ("manual" , manualFlag)- , ("help" , helpFlag)- , ("lhs2tex" , lhs2texFlag)- , ("stdout" , stdoutFlag)- , ("overwrite" , overwriteFlag)- ]--readConf :: [String] -> Conf-readConf = go $ Conf False False False False False False False False [] []- where- go c [] = c- go c (x:xs) =- case x of- -- Arguments starting with '-' are considered a flag.- ('-':flag) ->- case flag of- "keep" -> go (c {keepFlag = True}) xs- "visible" -> go (c {visibleFlag = True}) xs- "verbose" -> go (c {verboseFlag = True}) xs- "manual" -> go (c {manualFlag = True}) xs- "help" -> go (c {helpFlag = True}) xs- "lhs2tex" -> go (c {lhs2texFlag = True}) xs- "stdout" -> go (c {stdoutFlag = True}) xs- "overwrite" -> go (c {overwriteFlag = True}) xs- _ -> go (c {unknownFlags = unknownFlags c ++ [flag]}) xs- -- Otherwise, an input file.- _ -> go (c {inputs = inputs c ++ [x]}) xs---- Haskintex--type Haskintex = ReaderT Conf IO--outputStr :: String -> Haskintex ()-outputStr str = do- b <- verboseFlag <$> ask- when b $ lift $ putStrLn str---- MAIN--main :: IO ()-main = (readConf <$> getArgs) >>= runReaderT haskintex--haskintex :: Haskintex ()-haskintex = do- flags <- ask- if -- If the help flag is passed, ignore everything else- -- and just print the help.- helpFlag flags- then lift $ putStr help- else let xs = inputs flags- in if null xs- then lift $ putStr noFiles- else mapM_ haskintexFile xs--commas :: [String] -> String-commas = concat . intersperse ", "--showEnabledFlags :: Haskintex ()-showEnabledFlags = do- c <- ask- outputStr $ "Enabled flags: "- ++ commas (foldr (\(str,f) xs -> if f c then str : xs else xs) [] supportedFlags)- ++ "."--reportWarnings :: Haskintex ()-reportWarnings = do- -- Combination of manual and lhs2tex flags.- manFlag <- manualFlag <$> ask- lhsFlag <- lhs2texFlag <$> ask- when (manFlag && lhsFlag) $- outputStr "Warning: lhs2tex flag is useless in presence of manual flag."--haskintexFile :: FilePath -> Haskintex ()-haskintexFile fp_ = do- -- If the given file does not exist, try adding '.htex'.- b <- lift $ doesFileExist fp_- let fp = if b then fp_ else fp_ ++ ".htex"- -- Report enabled flags- showEnabledFlags- -- Warnings- reportWarnings- -- Other unknown flags passed.- uFlags <- unknownFlags <$> ask- unless (null uFlags) $- outputStr $ "Unsupported flags: " ++ commas uFlags ++ "."- -- File parsing.- outputStr $ "Reading " ++ fp ++ "..."- vFlag <- visibleFlag <$> ask- t <- lift $ T.readFile fp- case parseOnly (parseSyntax vFlag) t of- Left err -> outputStr $ "Reading of " ++ fp ++ " failed: " ++ err- Right s -> do- -- First pass: Create haskell source from the code obtained with 'extractCode'.- let modName = ("Haskintex_" ++) $ dropExtension $ takeFileName fp- outputStr $ "Creating Haskell source file " ++ modName ++ ".hs..."- let hs = extractCode s- moduleHeader = pack $ "module " ++ modName ++ " where\n\n"- lift $ T.writeFile (modName ++ ".hs") $ moduleHeader <> hs- -- Second pass: Evaluate expressions using 'evalCode'.- outputStr $ "Evaluating expressions in " ++ fp ++ "..."- mFlag <- manualFlag <$> ask- lhsFlag <- lhs2texFlag <$> ask- l <- evalCode modName mFlag lhsFlag s- -- Write final output.- let fp' = dropExtension (takeFileName fp) ++ ".tex"- writeit = do outputStr $ "Writing final file at " ++ fp' ++ "..."- lift $ T.writeFile fp' l- outFlag <- stdoutFlag <$> ask- overFlag <- overwriteFlag <$> ask- nonew <- lift $ doesFileExist fp'- let finalOutput- | outFlag = do outputStr "Sending final output to stdout..."- lift $ T.putStr l- | overFlag = writeit- | nonew = do lift $ putStr $ "File " ++ fp' ++ " already exists. Overwrite?"- ++ " (use -overwrite to overwrite by default) "- lift $ hFlush stdout -- To immediately show the text on Windows systems.- resp <- lift getLine- if resp `elem` ["","y","yes"]- then writeit- else outputStr "No file was written."- | otherwise = writeit- finalOutput- -- If the keep flag is not set, remove the haskell source file.- kFlag <- keepFlag <$> ask- unless kFlag $ do- outputStr $ "Removing Haskell source file " ++ modName ++ ".hs "- ++ "(use -keep to avoid this)..."- lift $ removeFile $ modName ++ ".hs"- -- End.- outputStr $ "End of processing of file " ++ fp ++ "."---- MESSAGES--help :: String-help = unlines [- "You are using haskintex version " ++ showVersion version ++ "."- , "http://daniel-diaz.github.io/projects/haskintex"- , ""- , "Usage and flags:"- , "Any argument passed to haskintex that starts with '-' will be considered"- , "a flag. Otherwise, it will be considered an input file. Every input file"- , "will be processed with the same set of flags, which will include all the"- , "flags passed in the call. This is the list of flags supported by haskintex:"- , ""- , " -keep haskintex creates an intermmediate Haskell file before"- , " evaluating any expressions. By default, this file is "- , " eliminated after processing the file. Pass this flag to"- , " keep the file."- , ""- , " -visible By default, code written inside a writehaskell environment"- , " is not shown in the LaTeX output. This flag changes the"- , " default."- , ""- , " -verbose If this flag is enabled, haskintex will print information"- , " about its own execution while running."- , ""- , " -manual By default, Haskell expressions, either from writehaskell "- , " or evalhaskell, appear in the LaTeX output inside verb or"- , " verbatim declarations. If this flag is passed, neither verb"- , " nor verbatim will be used. The code will be written as text "- , " as it is. The user will decide how to handle it."- , ""- , " -help This flags cancels any other flag or input file and makes"- , " the program simply show this help message."- , ""- , " -stdout Instead of writing the output to a file, send it to the"- , " standard output stream (stdout)."- , ""- , " -lhs2tex Instead of using verb or verbatim declarations, format the"- , " output using the syntax accepted by lhs2TeX."- , ""- , " -overwrite Overwrite the output file if it already exists. If this flag"- , " is not set, the program will ask before overwriting."- , ""- , "Any unsupported flag will be ignored."- ]--noFiles :: String-noFiles = "No input file given.\n"
examples/fact.htex view
haskintex.cabal view
@@ -1,5 +1,5 @@ name: haskintex-version: 0.3.0.0+version: 0.3.1.0 synopsis: Haskell Evaluation inside of LaTeX code. description: The /haskintex/ (Haskell in LaTeX) program is a tool that reads a LaTeX file and evaluates Haskell expressions contained@@ -24,16 +24,23 @@ cabal-version: >=1.10 executable haskintex- main-is: Main.hs- other-modules: Paths_haskintex- build-depends: base >= 4.6 && < 4.7- , transformers == 0.3.*- , text >= 0.11.2.3 && < 0.12- , directory >= 1.2.0.0 && < 1.3- , filepath >= 1.1.0.0 && < 1.4- , process >= 1.1.0.2 && < 1.2- , HaTeX >= 3.9 && < 3.10- , attoparsec >= 0.10.2.0 && < 0.11- , hint- default-language: Haskell2010+ hs-source-dirs: main+ main-is: Main.hs+ build-depends: base == 4.*+ , haskintex+ default-language: Haskell2010 ghc-options: -Wall++library+ default-language: Haskell2010+ build-depends: base == 4.*+ , transformers == 0.3.*+ , text >= 0.11.2.3 && < 2+ , directory >= 1.2.0.0 && < 1.3+ , filepath >= 1.1.0.0 && < 1.4+ , process+ , HaTeX >= 3.9.0.0 && < 4+ , parsec >= 3.1.2 && < 3.2+ , hint >= 0.3.3.5 && < 0.4+ exposed-modules: Haskintex+ other-modules: Paths_haskintex
+ main/Main.hs view
@@ -0,0 +1,8 @@++module Main (main) where++import Haskintex+import System.Environment (getArgs)++main :: IO ()+main = getArgs >>= haskintex