diff --git a/Haskintex.hs b/Haskintex.hs new file mode 100644 --- /dev/null +++ b/Haskintex.hs @@ -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" diff --git a/Main.hs b/Main.hs deleted file mode 100644 --- a/Main.hs +++ /dev/null @@ -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" diff --git a/examples/fact.htex b/examples/fact.htex --- a/examples/fact.htex +++ b/examples/fact.htex diff --git a/haskintex.cabal b/haskintex.cabal --- a/haskintex.cabal +++ b/haskintex.cabal @@ -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 diff --git a/main/Main.hs b/main/Main.hs new file mode 100644 --- /dev/null +++ b/main/Main.hs @@ -0,0 +1,8 @@ + +module Main (main) where + +import Haskintex +import System.Environment (getArgs) + +main :: IO () +main = getArgs >>= haskintex