diff --git a/Haskintex.hs b/Haskintex.hs --- a/Haskintex.hs +++ b/Haskintex.hs @@ -14,7 +14,7 @@ import qualified Data.Text.IO as T -- Parser -- import Data.Attoparsec.Text -import Text.Parsec hiding (many) +import Text.Parsec hiding (many,(<|>)) import Text.Parsec.Text -- Transformers import Control.Monad (when,unless) @@ -41,19 +41,25 @@ -- to this structure. It differentiates between these parts: -- -- * writehaskell environments (WriteHaskell), either marked --- visible or not. +-- visible or not, located either in the header (for pragmas) +-- or in the body (for regular code). -- -- * Haskell expression of type 'LaTeX' (InsertHaTeX). -- See the HaTeX package for details about this type. -- +-- * Haskell expression of tyep 'IO LaTeX' (InsertHaTeXIO). +-- Exactly like InsertHaTeX, but within the IO monad. +-- -- * evalhaskell commands and environments (EvalHaskell). -- -- * Anything else (WriteLaTeX). -- data Syntax = WriteLaTeX Text - | WriteHaskell Bool Text -- False for Hidden, True for Visible + | WriteHaskell Bool Bool Text -- First Bool: False for Hidden, True for Visible. + -- Second Bool: True for Header, False for Body. | InsertHaTeX Text + | InsertHaTeXIO Text | EvalHaskell Bool Text -- False for Command, True for Environment | Sequence [Syntax] deriving Show -- Show instance for debugging. @@ -62,18 +68,19 @@ parseSyntax :: Bool -> Parser Syntax parseSyntax v = do - s <- fmap Sequence $ many $ choice $ fmap try [ p_writehaskell v, p_inserthatex, p_evalhaskell, p_writelatex ] + s <- fmap Sequence $ many $ choice $ fmap try [ p_writehaskell v, p_inserthatex, p_inserthatexio , p_evalhaskell, p_writelatex ] eof return s p_writehaskell :: Bool -> Parser Syntax p_writehaskell v = do - _ <- string "\\begin{writehaskell}" + isH <- (try $ string "\\begin{writehaskell}" >> return False) + <|> (string "\\begin{haskellpragmas}" >> return True) 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 + h <- manyTill anyChar $ try $ string $ if isH then "\\end{haskellpragmas}" else "\\end{writehaskell}" + return $ WriteHaskell b isH $ pack h p_inserthatex :: Parser Syntax p_inserthatex = do @@ -81,6 +88,12 @@ h <- p_haskell 0 return $ InsertHaTeX $ pack h +p_inserthatexio :: Parser Syntax +p_inserthatexio = do + _ <- string "\\iohatex{" + h <- p_haskell 0 + return $ InsertHaTeXIO $ pack h + p_evalhaskell :: Parser Syntax p_evalhaskell = choice $ fmap try [ p_evalhaskellenv, p_evalhaskellcomm ] @@ -124,17 +137,19 @@ 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 + [ string "\\begin{writehaskell}" >> return False -- starts p_writehaskell (for body) + , string "\\begin{haskellpragmas}" >> return False -- starts p_writehaskell (for header) + , string "\\hatex" >> return False -- starts p_inserthatex + , string "\\iohatex" >> return False -- starts p_inserthatexio + , 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 :: Syntax -> (Text,Text) +extractCode (WriteHaskell _ isH t) = if isH then (t,mempty) else (mempty,t) extractCode (Sequence xs) = foldMap extractCode xs extractCode _ = mempty @@ -147,7 +162,7 @@ evalCode modName mFlag lhsFlag = go where go (WriteLaTeX t) = return t - go (WriteHaskell b t) = + go (WriteHaskell b _ t) = let f :: Text -> LaTeX f x | not b = mempty | mFlag = raw x @@ -169,6 +184,21 @@ ++ errorString err return mempty Right l -> return $ render l + go (InsertHaTeXIO t) = do + let e = unpack $ T.strip t + int = do + loadModules [modName] + setTopLevelModules [modName] + setImports ["Prelude"] + interpret e (as :: IO LaTeX) + outputStr $ "Evaluation (IO 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 -> liftIO $ render <$> l go (EvalHaskell env t) = let f :: Text -> LaTeX f x | mFlag = raw x -- Manual flag overrides lhs2tex flag behavior @@ -224,6 +254,7 @@ , lhs2texFlag :: Bool , stdoutFlag :: Bool , overwriteFlag :: Bool + , debugFlag :: Bool , unknownFlags :: [String] , inputs :: [FilePath] } @@ -238,10 +269,11 @@ , ("lhs2tex" , lhs2texFlag) , ("stdout" , stdoutFlag) , ("overwrite" , overwriteFlag) + , ("debug" , debugFlag) ] readConf :: [String] -> Conf -readConf = go $ Conf False False False False False False False False [] [] +readConf = go $ Conf False False False False False False False False False [] [] where go c [] = c go c (x:xs) = @@ -257,6 +289,7 @@ "lhs2tex" -> go (c {lhs2texFlag = True}) xs "stdout" -> go (c {stdoutFlag = True}) xs "overwrite" -> go (c {overwriteFlag = True}) xs + "debug" -> go (c {debugFlag = True}) xs _ -> go (c {unknownFlags = unknownFlags c ++ [flag]}) xs -- Otherwise, an input file. _ -> go (c {inputs = inputs c ++ [x]}) xs @@ -270,6 +303,12 @@ b <- verboseFlag <$> ask when b $ lift $ putStrLn str +-- | Run haskintex with the given arguments. For example: +-- +-- > haskintex ["-visible","-overwrite"] +-- +-- Useful if you want to call /haskintex/ from another program. +-- This function does /not/ do any system call. haskintex :: [String] -> IO () haskintex = runReaderT haskintexmain . readConf @@ -325,12 +364,18 @@ case parse (parseSyntax vFlag) fp t of Left err -> outputStr $ "Reading of " ++ fp ++ " failed:\n" ++ show err Right s -> do + -- Zero pass: In case of debugging, write down the parsed AST. + dbugFlag <- debugFlag <$> ask + when dbugFlag $ do + let debugfp = dropExtension (takeFileName fp) ++ ".debughtex" + outputStr $ "Writing file " ++ debugfp ++ " with debugging output..." + lift $ writeFile debugfp $ show s -- 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 + let (hsH,hs) = extractCode s + moduleHeader = pack $ "\nmodule " ++ modName ++ " where\n\n" + lift $ T.writeFile (modName ++ ".hs") $ hsH <> moduleHeader <> hs -- Second pass: Evaluate expressions using 'evalCode'. outputStr $ "Evaluating expressions in " ++ fp ++ "..." mFlag <- manualFlag <$> ask @@ -407,6 +452,10 @@ , "" , " -overwrite Overwrite the output file if it already exists. If this flag" , " is not set, the program will ask before overwriting." + , "" + , " -debug Only for debugging purposes. It writes a file with extension" + , " .debughtex with the AST of the internal representation of the" + , " input file haskintex uses." , "" , "Any unsupported flag will be ignored." ] diff --git a/examples/io.htex b/examples/io.htex new file mode 100644 --- /dev/null +++ b/examples/io.htex @@ -0,0 +1,10 @@ +\documentclass{article} +\begin{document} +\begin{writehaskell} +import Text.LaTeX +import Data.Time (getCurrentTime) +import Control.Applicative ((<$>)) +import Data.String (fromString) +\end{writehaskell} +I am testing the \texttt{iohatex} command when the time is \iohatex{fromString . show <$> getCurrentTime}. +\end{document} diff --git a/examples/pragmas.htex b/examples/pragmas.htex new file mode 100644 --- /dev/null +++ b/examples/pragmas.htex @@ -0,0 +1,13 @@ +\documentclass{article} +\begin{document} +\begin{haskellpragmas} +{-# LANGUAGE OverloadedStrings #-} +\end{haskellpragmas} +\begin{writehaskell} +import Text.LaTeX + +overloaded :: LaTeX +overloaded = "This is an Overloaded String." +\end{writehaskell} +\hatex{overloaded} +\end{document} diff --git a/examples/string.htex b/examples/string.htex new file mode 100644 --- /dev/null +++ b/examples/string.htex @@ -0,0 +1,4 @@ +\documentclass{article} +\begin{document} +The string ``hello{{'' contains \evalhaskell{length ("hello{{" :: String)} characters. +\end{document} diff --git a/haskintex.cabal b/haskintex.cabal --- a/haskintex.cabal +++ b/haskintex.cabal @@ -1,5 +1,5 @@ name: haskintex -version: 0.3.1.1 +version: 0.4.0.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 @@ -21,6 +21,9 @@ examples/fact.htex examples/hatex.htex examples/sine.htex + examples/io.htex + examples/pragmas.htex + examples/string.htex cabal-version: >=1.10 executable haskintex @@ -41,6 +44,6 @@ , process , HaTeX >= 3.9.0.0 && < 4 , parsec >= 3.1.2 && < 3.2 - , hint >= 0.3.3.5 && < 0.4 + , hint >= 0.3.3.5 && < 0.5 exposed-modules: Haskintex other-modules: Paths_haskintex