{-# LANGUAGE OverloadedStrings, CPP #-}

module Haskintex (haskintex) where

-- System
import System.Process (readProcess, readCreateProcess, shell)
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
import Data.Text.Encoding
-- Parser
import Text.Parsec hiding (many,(<|>))
import Text.Parsec.Text ()
-- Transformers
import Control.Monad (when,unless,replicateM)
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
-- LaTeX
import Text.LaTeX hiding (version)
import qualified Text.LaTeX as Hatex
import Text.LaTeX.Base.Syntax
-- Utils
import Control.Applicative
#if !MIN_VERSION_base(4,8,0)
import Data.Foldable (foldMap)
#endif
import Numeric (showFFloat)
-- Paths
import Paths_haskintex (version)
import Data.Version (showVersion)
-- Lists
import Data.List (intersperse, isSuffixOf)
-- GHC
import Language.Haskell.Interpreter hiding (get, modName)
import Language.Haskell.Interpreter.Unsafe (unsafeRunInterpreterWithArgs)
import Data.Typeable
import qualified Language.Haskell.Exts.Pretty as H
import qualified Language.Haskell.Exts.Parser as H
import qualified Language.Haskell.Exts.Syntax as H
-- Map
import qualified Data.Map as M
-- Binary
import Data.Binary.Put
import Data.Binary.Get hiding (lookAhead)
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString as SB

-- 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, 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 -- Visibility: False for Hidden, True for Visible
                 Bool -- Location: True for Header, False for Body
                 Text
  | InsertHaTeX  Bool -- Memorized expression?
                 Text
  | InsertHaTeXIO Bool -- Memorized expression?
                  Text
  | EvalHaskell  Bool -- Type: False for Command, True for Environment
                 Bool -- Memorized expression?
                 Text
  | Sequence     [Syntax]
    deriving Int -> Syntax -> ShowS
[Syntax] -> ShowS
Syntax -> [Char]
(Int -> Syntax -> ShowS)
-> (Syntax -> [Char]) -> ([Syntax] -> ShowS) -> Show Syntax
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Syntax -> ShowS
showsPrec :: Int -> Syntax -> ShowS
$cshow :: Syntax -> [Char]
show :: Syntax -> [Char]
$cshowList :: [Syntax] -> ShowS
showList :: [Syntax] -> ShowS
Show -- Show instance for debugging.

-- Configuration

-- | Possible sources of package DBs. The value of the type is constructed from
-- CLI argument and tells haskintex which strategy to use for package DB selection.
--
-- If no CLI argument is presented, haskintex tries to guess from local environment
-- which package DB to use.
data PackageDB =
    CabalSandboxDB -- ^ Pick package-db from `.cabal-sandbox` folder
  | StackDB -- ^ Pick package-db from `stack path`
  deriving Int -> PackageDB -> ShowS
[PackageDB] -> ShowS
PackageDB -> [Char]
(Int -> PackageDB -> ShowS)
-> (PackageDB -> [Char])
-> ([PackageDB] -> ShowS)
-> Show PackageDB
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageDB -> ShowS
showsPrec :: Int -> PackageDB -> ShowS
$cshow :: PackageDB -> [Char]
show :: PackageDB -> [Char]
$cshowList :: [PackageDB] -> ShowS
showList :: [PackageDB] -> ShowS
Show

-- | True if the input value is cabal sandbox package-db
isCabalSandboxDB :: PackageDB -> Bool
isCabalSandboxDB :: PackageDB -> Bool
isCabalSandboxDB PackageDB
v = case PackageDB
v of
  PackageDB
CabalSandboxDB -> Bool
True
  PackageDB
_ -> Bool
False

-- | True if the input value is stack package-db
isStackDB :: PackageDB -> Bool
isStackDB :: PackageDB -> Bool
isStackDB PackageDB
v = case PackageDB
v of
  PackageDB
StackDB -> Bool
True
  PackageDB
_ -> Bool
False

data Conf = Conf
  { Conf -> Bool
keepFlag      :: Bool
  , Conf -> Bool
visibleFlag   :: Bool
  , Conf -> Bool
verboseFlag   :: Bool
  , Conf -> Bool
manualFlag    :: Bool
  , Conf -> Bool
helpFlag      :: Bool
  , Conf -> Bool
lhs2texFlag   :: Bool
  , Conf -> Bool
stdoutFlag    :: Bool
  , Conf -> Bool
overwriteFlag :: Bool
  , Conf -> Bool
debugFlag     :: Bool
  , Conf -> Bool
memoFlag      :: Bool
  , Conf -> Bool
memocleanFlag :: Bool
  , Conf -> Bool
autotexyFlag  :: Bool
  , Conf -> Bool
nosandboxFlag :: Bool
  , Conf -> Maybe PackageDB
packageDb     :: Maybe PackageDB
  , Conf -> Bool
werrorFlag    :: Bool
  , Conf -> [[Char]]
unknownFlags  :: [String]
  , Conf -> [[Char]]
inputs        :: [FilePath]
  , Conf -> MemoTree
memoTree      :: MemoTree
    }

supportedFlags :: [(String,Conf -> Bool)]
supportedFlags :: [([Char], Conf -> Bool)]
supportedFlags =
  [ ([Char]
"keep"      , Conf -> Bool
keepFlag)
  , ([Char]
"visible"   , Conf -> Bool
visibleFlag)
  , ([Char]
"verbose"   , Conf -> Bool
verboseFlag)
  , ([Char]
"manual"    , Conf -> Bool
manualFlag)
  , ([Char]
"help"      , Conf -> Bool
helpFlag)
  , ([Char]
"lhs2tex"   , Conf -> Bool
lhs2texFlag)
  , ([Char]
"stdout"    , Conf -> Bool
stdoutFlag)
  , ([Char]
"overwrite" , Conf -> Bool
overwriteFlag)
  , ([Char]
"debug"     , Conf -> Bool
debugFlag)
  , ([Char]
"memo"      , Conf -> Bool
memoFlag)
  , ([Char]
"memoclean" , Conf -> Bool
memocleanFlag)
  , ([Char]
"autotexy"  , Conf -> Bool
autotexyFlag)
  , ([Char]
"nosandbox" , Conf -> Bool
nosandboxFlag)
  , ([Char]
"cabaldb"   , Bool -> (PackageDB -> Bool) -> Maybe PackageDB -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False PackageDB -> Bool
isCabalSandboxDB (Maybe PackageDB -> Bool)
-> (Conf -> Maybe PackageDB) -> Conf -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conf -> Maybe PackageDB
packageDb)
  , ([Char]
"stackdb"   , Bool -> (PackageDB -> Bool) -> Maybe PackageDB -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False PackageDB -> Bool
isStackDB (Maybe PackageDB -> Bool)
-> (Conf -> Maybe PackageDB) -> Conf -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conf -> Maybe PackageDB
packageDb)
  , ([Char]
"werror"    , Conf -> Bool
werrorFlag)
    ]

readConf :: [String] -> Conf
readConf :: [[Char]] -> Conf
readConf = Conf -> [[Char]] -> Conf
go (Conf -> [[Char]] -> Conf) -> Conf -> [[Char]] -> Conf
forall a b. (a -> b) -> a -> b
$ Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe PackageDB
-> Bool
-> [[Char]]
-> [[Char]]
-> MemoTree
-> Conf
Conf Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Bool
False Maybe PackageDB
forall a. Maybe a
Nothing Bool
False [] [] MemoTree
forall k a. Map k a
M.empty
  where
    go :: Conf -> [[Char]] -> Conf
go Conf
c [] = Conf
c
    go Conf
c ([Char]
x:[[Char]]
xs) =
       case [Char]
x of
        -- Arguments starting with '-' are considered a flag.
        (Char
'-':[Char]
flag) ->
           case [Char]
flag of
             [Char]
"keep"      -> Conf -> [[Char]] -> Conf
go (Conf
c {keepFlag      = True}) [[Char]]
xs
             [Char]
"visible"   -> Conf -> [[Char]] -> Conf
go (Conf
c {visibleFlag   = True}) [[Char]]
xs
             [Char]
"verbose"   -> Conf -> [[Char]] -> Conf
go (Conf
c {verboseFlag   = True}) [[Char]]
xs
             [Char]
"manual"    -> Conf -> [[Char]] -> Conf
go (Conf
c {manualFlag    = True}) [[Char]]
xs
             [Char]
"help"      -> Conf -> [[Char]] -> Conf
go (Conf
c {helpFlag      = True}) [[Char]]
xs
             [Char]
"lhs2tex"   -> Conf -> [[Char]] -> Conf
go (Conf
c {lhs2texFlag   = True}) [[Char]]
xs
             [Char]
"stdout"    -> Conf -> [[Char]] -> Conf
go (Conf
c {stdoutFlag    = True}) [[Char]]
xs
             [Char]
"overwrite" -> Conf -> [[Char]] -> Conf
go (Conf
c {overwriteFlag = True}) [[Char]]
xs
             [Char]
"debug"     -> Conf -> [[Char]] -> Conf
go (Conf
c {debugFlag     = True}) [[Char]]
xs
             [Char]
"memo"      -> Conf -> [[Char]] -> Conf
go (Conf
c {memoFlag      = True}) [[Char]]
xs
             [Char]
"memoclean" -> Conf -> [[Char]] -> Conf
go (Conf
c {memocleanFlag = True}) [[Char]]
xs
             [Char]
"autotexy"  -> Conf -> [[Char]] -> Conf
go (Conf
c {autotexyFlag  = True}) [[Char]]
xs
             [Char]
"nosandbox" -> Conf -> [[Char]] -> Conf
go (Conf
c {nosandboxFlag = True}) [[Char]]
xs
             [Char]
"cabaldb"   -> Conf -> [[Char]] -> Conf
go (Conf
c {packageDb     = Just CabalSandboxDB}) [[Char]]
xs
             [Char]
"stackdb"   -> Conf -> [[Char]] -> Conf
go (Conf
c {packageDb     = Just StackDB}) [[Char]]
xs
             [Char]
"werror"    -> Conf -> [[Char]] -> Conf
go (Conf
c {werrorFlag    = True}) [[Char]]
xs
             [Char]
_           -> Conf -> [[Char]] -> Conf
go (Conf
c {unknownFlags = unknownFlags c ++ [flag]}) [[Char]]
xs
        -- Otherwise, an input file.
        [Char]
_ -> Conf -> [[Char]] -> Conf
go (Conf
c {inputs = inputs c ++ [x]}) [[Char]]
xs

-- Haskintex monad

type Haskintex = StateT Conf IO

outputStr :: String -> Haskintex ()
outputStr :: [Char] -> Haskintex ()
outputStr [Char]
str = do
  Bool
b <- Conf -> Bool
verboseFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
  Bool -> Haskintex () -> Haskintex ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (Haskintex () -> Haskintex ()) -> Haskintex () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ IO () -> Haskintex ()
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Haskintex ()) -> IO () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
str

-- PARSING

type Parser = ParsecT Text () Haskintex

parseSyntax :: Parser Syntax
parseSyntax :: Parser Syntax
parseSyntax = do
  Syntax
s <- ([Syntax] -> Syntax)
-> ParsecT Text () Haskintex [Syntax] -> Parser Syntax
forall a b.
(a -> b)
-> ParsecT Text () Haskintex a -> ParsecT Text () Haskintex b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Syntax] -> Syntax
Sequence (ParsecT Text () Haskintex [Syntax] -> Parser Syntax)
-> ParsecT Text () Haskintex [Syntax] -> Parser Syntax
forall a b. (a -> b) -> a -> b
$ Parser Syntax -> ParsecT Text () Haskintex [Syntax]
forall a.
ParsecT Text () Haskintex a -> ParsecT Text () Haskintex [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Syntax -> ParsecT Text () Haskintex [Syntax])
-> Parser Syntax -> ParsecT Text () Haskintex [Syntax]
forall a b. (a -> b) -> a -> b
$ [Parser Syntax] -> Parser Syntax
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ Parser Syntax
p_writehaskell, Bool -> Parser Syntax
p_inserthatex Bool
False , Bool -> Parser Syntax
p_inserthatex Bool
True , Parser Syntax
p_evalhaskell, Parser Syntax
p_writelatex ]
  ParsecT Text () Haskintex ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  Syntax -> Parser Syntax
forall a. a -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Syntax
s

p_writehaskell :: Parser Syntax
p_writehaskell :: Parser Syntax
p_writehaskell = do
  Bool
isH <- (ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool)
-> ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\begin{writehaskell}" ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool
forall a b.
ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b -> ParsecT Text () Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text () Haskintex Bool
forall a. a -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
           ParsecT Text () Haskintex Bool
-> ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool
forall a.
ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex a -> ParsecT Text () Haskintex a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool)
-> ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\begin{haskellpragmas}" ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool
forall a b.
ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b -> ParsecT Text () Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text () Haskintex Bool
forall a. a -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
  Bool
b <- [ParsecT Text () Haskintex Bool] -> ParsecT Text () Haskintex Bool
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT Text () Haskintex Bool]
 -> ParsecT Text () Haskintex Bool)
-> [ParsecT Text () Haskintex Bool]
-> ParsecT Text () Haskintex Bool
forall a b. (a -> b) -> a -> b
$ (ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool)
-> [ParsecT Text () Haskintex Bool]
-> [ParsecT Text () Haskintex Bool]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try [ [Char] -> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"[hidden]"  ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool
forall a b.
ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b -> ParsecT Text () Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text () Haskintex Bool
forall a. a -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                         , [Char] -> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"[visible]" ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool
forall a b.
ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b -> ParsecT Text () Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text () Haskintex Bool
forall a. a -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                         , StateT Conf IO Bool -> ParsecT Text () Haskintex Bool
forall (m :: * -> *) a. Monad m => m a -> ParsecT Text () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Conf IO Bool -> ParsecT Text () Haskintex Bool)
-> StateT Conf IO Bool -> ParsecT Text () Haskintex Bool
forall a b. (a -> b) -> a -> b
$ Conf -> Bool
visibleFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get ] -- When no option is given, take the default.
  [Char]
h <- ParsecT Text () Haskintex Char
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text () Haskintex Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT Text () Haskintex [Char]
 -> ParsecT Text () Haskintex [Char])
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Haskintex [Char]
 -> ParsecT Text () Haskintex [Char])
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string ([Char] -> ParsecT Text () Haskintex [Char])
-> [Char] -> ParsecT Text () Haskintex [Char]
forall a b. (a -> b) -> a -> b
$ if Bool
isH then [Char]
"\\end{haskellpragmas}" else [Char]
"\\end{writehaskell}"
  Syntax -> Parser Syntax
forall a. a -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return (Syntax -> Parser Syntax) -> Syntax -> Parser Syntax
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Text -> Syntax
WriteHaskell Bool
b Bool
isH (Text -> Syntax) -> Text -> Syntax
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack [Char]
h

readMemo :: Parser Bool
readMemo :: ParsecT Text () Haskintex Bool
readMemo = (Char -> ParsecT Text () Haskintex Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[' ParsecT Text () Haskintex Char
-> ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool
forall a b.
ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b -> ParsecT Text () Haskintex b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ParsecT Text () Haskintex Bool] -> ParsecT Text () Haskintex Bool
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT Text () Haskintex Bool]
forall {u}. [ParsecT Text u Haskintex Bool]
xs ParsecT Text () Haskintex Bool
-> ParsecT Text () Haskintex Char -> ParsecT Text () Haskintex Bool
forall a b.
ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b -> ParsecT Text () Haskintex a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT Text () Haskintex Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') ParsecT Text () Haskintex Bool
-> ParsecT Text () Haskintex Bool -> ParsecT Text () Haskintex Bool
forall a.
ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex a -> ParsecT Text () Haskintex a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT Conf IO Bool -> ParsecT Text () Haskintex Bool
forall (m :: * -> *) a. Monad m => m a -> ParsecT Text () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Conf -> Bool
memoFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get)
  where
    xs :: [ParsecT Text u Haskintex Bool]
xs = [ [Char] -> ParsecT Text u Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"memo" ParsecT Text u Haskintex [Char]
-> ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool
forall a b.
ParsecT Text u Haskintex a
-> ParsecT Text u Haskintex b -> ParsecT Text u Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text u Haskintex Bool
forall a. a -> ParsecT Text u Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
         , [Char] -> ParsecT Text u Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"notmemo" ParsecT Text u Haskintex [Char]
-> ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool
forall a b.
ParsecT Text u Haskintex a
-> ParsecT Text u Haskintex b -> ParsecT Text u Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text u Haskintex Bool
forall a. a -> ParsecT Text u Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False ]

processExp :: (H.Exp () -> H.Exp ()) -- ^ Transformation to apply to Haskell Expression
           -> Text -- ^ Haskell expression
           -> Parser Text
processExp :: (Exp () -> Exp ()) -> Text -> Parser Text
processExp Exp () -> Exp ()
f Text
t = do
  Text -> Parser Text
forall a. a -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser Text) -> Text -> Parser Text
forall a b. (a -> b) -> a -> b
$ case [Char] -> ParseResult (Exp SrcSpanInfo)
H.parseExp (Text -> [Char]
unpack Text
t) of
    H.ParseOk Exp SrcSpanInfo
e -> [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ Exp () -> [Char]
forall a. Pretty a => a -> [Char]
H.prettyPrint (Exp () -> [Char]) -> Exp () -> [Char]
forall a b. (a -> b) -> a -> b
$ Exp () -> Exp ()
f (Exp () -> Exp ()) -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ () -> SrcSpanInfo -> ()
forall a b. a -> b -> a
const () (SrcSpanInfo -> ()) -> Exp SrcSpanInfo -> Exp ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Exp SrcSpanInfo
e
    ParseResult (Exp SrcSpanInfo)
_ -> Text
t

p_inserthatex :: Bool -- False for pure, True for IO
              -> Parser Syntax
p_inserthatex :: Bool -> Parser Syntax
p_inserthatex Bool
isIO = do
  --
  let iden :: [Char]
iden = if Bool
isIO then [Char]
"iohatex" else [Char]
"hatex"
      cons :: Bool -> Text -> Syntax
cons = if Bool
isIO then Bool -> Text -> Syntax
InsertHaTeXIO else Bool -> Text -> Syntax
InsertHaTeX
  --
  [Char]
_ <- ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Haskintex [Char]
 -> ParsecT Text () Haskintex [Char])
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string ([Char] -> ParsecT Text () Haskintex [Char])
-> [Char] -> ParsecT Text () Haskintex [Char]
forall a b. (a -> b) -> a -> b
$ Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: [Char]
iden
  Bool
b <- ParsecT Text () Haskintex Bool
readMemo
  Char
_ <- Char -> ParsecT Text () Haskintex Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
  [Char]
h <- Int -> ParsecT Text () Haskintex [Char]
p_haskell Int
0
  Bool
auto <- StateT Conf IO Bool -> ParsecT Text () Haskintex Bool
forall (m :: * -> *) a. Monad m => m a -> ParsecT Text () m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT Conf IO Bool -> ParsecT Text () Haskintex Bool)
-> StateT Conf IO Bool -> ParsecT Text () Haskintex Bool
forall a b. (a -> b) -> a -> b
$ Conf -> Bool
autotexyFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let v :: [Char] -> Exp ()
v = () -> QName () -> Exp ()
forall l. l -> QName l -> Exp l
H.Var () (QName () -> Exp ()) -> ([Char] -> QName ()) -> [Char] -> Exp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Name () -> QName ()
forall l. l -> Name l -> QName l
H.UnQual () (Name () -> QName ()) -> ([Char] -> Name ()) -> [Char] -> QName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> [Char] -> Name ()
forall l. l -> [Char] -> Name l
H.Ident ()
      f :: Exp () -> Exp ()
f = if Bool
auto then () -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
H.App () (Exp () -> Exp () -> Exp ()) -> Exp () -> Exp () -> Exp ()
forall a b. (a -> b) -> a -> b
$ if Bool
isIO then () -> Exp () -> Exp () -> Exp ()
forall l. l -> Exp l -> Exp l -> Exp l
H.App () ([Char] -> Exp ()
v [Char]
"fmap") ([Char] -> Exp ()
v [Char]
"texy")
                                          else [Char] -> Exp ()
v [Char]
"texy"
                  else Exp () -> Exp ()
forall a. a -> a
id
  Bool -> Text -> Syntax
cons Bool
b (Text -> Syntax) -> Parser Text -> Parser Syntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Exp () -> Exp ()) -> Text -> Parser Text
processExp Exp () -> Exp ()
f ([Char] -> Text
pack [Char]
h)

p_evalhaskell :: Parser Syntax
p_evalhaskell :: Parser Syntax
p_evalhaskell = [Parser Syntax] -> Parser Syntax
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ Parser Syntax
p_evalhaskellenv, Parser Syntax
p_evalhaskellcomm ]

p_evalhaskellenv :: Parser Syntax
p_evalhaskellenv :: Parser Syntax
p_evalhaskellenv = do
  [Char]
_ <- ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Haskintex [Char]
 -> ParsecT Text () Haskintex [Char])
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\begin{evalhaskell}"
  Bool
b <- ParsecT Text () Haskintex Bool
readMemo
  [Char]
h <- ParsecT Text () Haskintex Char
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text () Haskintex Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT Text () Haskintex [Char]
 -> ParsecT Text () Haskintex [Char])
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Haskintex [Char]
 -> ParsecT Text () Haskintex [Char])
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\end{evalhaskell}"
  Bool -> Bool -> Text -> Syntax
EvalHaskell Bool
True Bool
b (Text -> Syntax) -> Parser Text -> Parser Syntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Exp () -> Exp ()) -> Text -> Parser Text
processExp Exp () -> Exp ()
forall a. a -> a
id ([Char] -> Text
pack [Char]
h)

p_evalhaskellcomm :: Parser Syntax
p_evalhaskellcomm :: Parser Syntax
p_evalhaskellcomm = do
  [Char]
_  <- ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Haskintex [Char]
 -> ParsecT Text () Haskintex [Char])
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\evalhaskell"
  Bool
b <- ParsecT Text () Haskintex Bool
readMemo
  Char
_ <- Char -> ParsecT Text () Haskintex Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
  [Char]
h  <- Int -> ParsecT Text () Haskintex [Char]
p_haskell Int
0
  Bool -> Bool -> Text -> Syntax
EvalHaskell Bool
False Bool
b (Text -> Syntax) -> Parser Text -> Parser Syntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Exp () -> Exp ()) -> Text -> Parser Text
processExp Exp () -> Exp ()
forall a. a -> a
id ([Char] -> Text
pack [Char]
h)

p_haskell :: Int -> Parser String
p_haskell :: Int -> ParsecT Text () Haskintex [Char]
p_haskell Int
n = [ParsecT Text () Haskintex [Char]]
-> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
    do Char
_ <- Char -> ParsecT Text () Haskintex Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'{'
       (Char
'{'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Text () Haskintex [Char]
p_haskell (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
  , do Char
_ <- Char -> ParsecT Text () Haskintex Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'}'
       if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
          then [Char] -> ParsecT Text () Haskintex [Char]
forall a. a -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return []
          else (Char
'}'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Text () Haskintex [Char]
p_haskell (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
  , do Char
_ <- Char -> ParsecT Text () Haskintex Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'
       ([Char] -> ShowS)
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b c.
(a -> b -> c)
-> ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b
-> ParsecT Text () Haskintex c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
(++) ((Char
'\"'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Haskintex [Char]
p_string) (Int -> ParsecT Text () Haskintex [Char]
p_haskell Int
n)
  , ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"'{'") ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b.
ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b -> ParsecT Text () Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Text () Haskintex [Char]
forall a. a -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"'{'"
  , ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([Char] -> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"'}'") ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b.
ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b -> ParsecT Text () Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Text () Haskintex [Char]
forall a. a -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"'}'"
  , (Char -> ShowS)
-> ParsecT Text () Haskintex Char
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b c.
(a -> b -> c)
-> ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b
-> ParsecT Text () Haskintex c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) ParsecT Text () Haskintex Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Int -> ParsecT Text () Haskintex [Char]
p_haskell Int
n)
    ]

p_string :: Parser String
p_string :: ParsecT Text () Haskintex [Char]
p_string = [ParsecT Text () Haskintex [Char]]
-> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [
    ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Haskintex [Char]
 -> ParsecT Text () Haskintex [Char])
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> ShowS)
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b c.
(a -> b -> c)
-> ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b
-> ParsecT Text () Haskintex c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
(++) (Char -> ParsecT Text () Haskintex Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT Text () Haskintex Char
-> ParsecT Text () Haskintex Char -> ParsecT Text () Haskintex Char
forall a b.
ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b -> ParsecT Text () Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT Text () Haskintex Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"' ParsecT Text () Haskintex Char
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b.
ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b -> ParsecT Text () Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> ParsecT Text () Haskintex [Char]
forall a. a -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"\\\"") ParsecT Text () Haskintex [Char]
p_string
  , (Char -> ShowS)
-> ParsecT Text () Haskintex Char
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b c.
(a -> b -> c)
-> ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b
-> ParsecT Text () Haskintex c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) (Char -> ParsecT Text () Haskintex Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"') ([Char] -> ParsecT Text () Haskintex [Char]
forall a. a -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
  , (Char -> ShowS)
-> ParsecT Text () Haskintex Char
-> ParsecT Text () Haskintex [Char]
-> ParsecT Text () Haskintex [Char]
forall a b c.
(a -> b -> c)
-> ParsecT Text () Haskintex a
-> ParsecT Text () Haskintex b
-> ParsecT Text () Haskintex c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) ParsecT Text () Haskintex Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar ParsecT Text () Haskintex [Char]
p_string
    ]

p_writelatex :: Parser Syntax
p_writelatex :: Parser Syntax
p_writelatex = (Text -> Syntax
WriteLaTeX (Text -> Syntax) -> ([Char] -> Text) -> [Char] -> Syntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
pack) ([Char] -> Syntax)
-> ParsecT Text () Haskintex [Char] -> Parser Syntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  ParsecT Text () Haskintex Char -> ParsecT Text () Haskintex [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text () Haskintex Bool
forall {u}. ParsecT Text u Haskintex Bool
p_other ParsecT Text () Haskintex Bool
-> (Bool -> ParsecT Text () Haskintex Char)
-> ParsecT Text () Haskintex Char
forall a b.
ParsecT Text () Haskintex a
-> (a -> ParsecT Text () Haskintex b)
-> ParsecT Text () Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> if Bool
b then ParsecT Text () Haskintex Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar else [Char] -> ParsecT Text () Haskintex Char
forall a. [Char] -> ParsecT Text () Haskintex a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"stop write latex")
  where
    p_other :: ParsecT Text u Haskintex Bool
p_other =
      [ParsecT Text u Haskintex Bool] -> ParsecT Text u Haskintex Bool
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT Text u Haskintex Bool] -> ParsecT Text u Haskintex Bool)
-> [ParsecT Text u Haskintex Bool] -> ParsecT Text u Haskintex Bool
forall a b. (a -> b) -> a -> b
$ (ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool)
-> [ParsecT Text u Haskintex Bool]
-> [ParsecT Text u Haskintex Bool]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool)
-> (ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool)
-> ParsecT Text u Haskintex Bool
-> ParsecT Text u Haskintex Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead)
             [ [Char] -> ParsecT Text u Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\begin{writehaskell}"   ParsecT Text u Haskintex [Char]
-> ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool
forall a b.
ParsecT Text u Haskintex a
-> ParsecT Text u Haskintex b -> ParsecT Text u Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text u Haskintex Bool
forall a. a -> ParsecT Text u Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- starts p_writehaskell (for body)
             , [Char] -> ParsecT Text u Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\begin{haskellpragmas}" ParsecT Text u Haskintex [Char]
-> ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool
forall a b.
ParsecT Text u Haskintex a
-> ParsecT Text u Haskintex b -> ParsecT Text u Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text u Haskintex Bool
forall a. a -> ParsecT Text u Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- starts p_writehaskell (for header)
             , [Char] -> ParsecT Text u Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\hatex"                 ParsecT Text u Haskintex [Char]
-> ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool
forall a b.
ParsecT Text u Haskintex a
-> ParsecT Text u Haskintex b -> ParsecT Text u Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text u Haskintex Bool
forall a. a -> ParsecT Text u Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- starts p_inserthatex
             , [Char] -> ParsecT Text u Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\iohatex"               ParsecT Text u Haskintex [Char]
-> ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool
forall a b.
ParsecT Text u Haskintex a
-> ParsecT Text u Haskintex b -> ParsecT Text u Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text u Haskintex Bool
forall a. a -> ParsecT Text u Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- starts p_inserthatexio
             , [Char] -> ParsecT Text u Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\begin{evalhaskell}"    ParsecT Text u Haskintex [Char]
-> ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool
forall a b.
ParsecT Text u Haskintex a
-> ParsecT Text u Haskintex b -> ParsecT Text u Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text u Haskintex Bool
forall a. a -> ParsecT Text u Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- starts p_evalhaskellenv
             , [Char] -> ParsecT Text u Haskintex [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"\\evalhaskell"           ParsecT Text u Haskintex [Char]
-> ParsecT Text u Haskintex Bool -> ParsecT Text u Haskintex Bool
forall a b.
ParsecT Text u Haskintex a
-> ParsecT Text u Haskintex b -> ParsecT Text u Haskintex b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text u Haskintex Bool
forall a. a -> ParsecT Text u Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False -- starts p_evalhaskellcomm
             , Bool -> ParsecT Text u Haskintex Bool
forall a. a -> ParsecT Text u Haskintex a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
             ]

----------------------------------------------------------
----------------------------------------------------------
-- MEMO TREE

-- | A 'MemoTree' maps each expression to its reduced form.
type MemoTree = M.Map Text Text

-- | Search in current directory and all parents dirs for given file.
-- Return 'True' if found such file, 'False' either way. Search is performed
-- until root folder is not hit.
doesFileExistsUp :: FilePath -> IO Bool
doesFileExistsUp :: [Char] -> IO Bool
doesFileExistsUp [Char]
fname = do
  [[Char]]
parents <- [Char] -> [[Char]]
getAllParents ([Char] -> [[Char]]) -> IO [Char] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Char]
getCurrentDirectory
  [Bool]
checks <- ([Char] -> IO Bool) -> [[Char]] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([Char] -> IO Bool
doesFileExist ([Char] -> IO Bool) -> ShowS -> [Char] -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> ShowS
</> [Char]
fname)) [[Char]]
parents
  Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
checks

-- | Generate list of all parents of the given path including the path itself.
getAllParents :: FilePath -> [FilePath]
getAllParents :: [Char] -> [[Char]]
getAllParents = [[Char]] -> [[Char]]
go ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
splitDirectories
  where
    go :: [[Char]] -> [[Char]]
go [] = []
    go [[Char]]
segs = let
      parent :: [Char]
parent = [[Char]] -> [Char]
joinPath ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse [[Char]]
segs
      in [Char]
parent [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]] -> [[Char]]
go (Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
drop Int
1 [[Char]]
segs)

-- | Try to detect cabal sandbox or stack project and get pathes to package DBs.
--
-- If ambigous situation is presented (both stack and cabal sandbox is found),
-- then fail with descriptive message.
autoDetectSandbox :: Haskintex (Maybe [String])
autoDetectSandbox :: Haskintex (Maybe [[Char]])
autoDetectSandbox = do
  Bool
noSandbox <- Conf -> Bool
nosandboxFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
  if Bool
noSandbox
     then do
       [Char] -> Haskintex ()
outputStr [Char]
"Ignoring sandbox."
       Maybe [[Char]] -> Haskintex (Maybe [[Char]])
forall a. a -> StateT Conf IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [[Char]]
forall a. Maybe a
Nothing
     else do Bool
inSandbox <- IO Bool -> StateT Conf IO Bool
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Bool -> StateT Conf IO Bool) -> IO Bool -> StateT Conf IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesDirectoryExist [Char]
".cabal-sandbox"
             Bool
hasStackFile <- IO Bool -> StateT Conf IO Bool
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Bool -> StateT Conf IO Bool) -> IO Bool -> StateT Conf IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExistsUp [Char]
"stack.yaml"
             case (Bool
inSandbox, Bool
hasStackFile) of
               (Bool
True, Bool
False) -> do
                 [Char] -> Haskintex ()
outputStr [Char]
"Detected cabal sandbox."
                 Haskintex (Maybe [[Char]])
loadCabalSandboxDBPaths
               (Bool
False, Bool
True) -> do
                 [Char] -> Haskintex ()
outputStr [Char]
"Detected stack sandbox."
                 Haskintex (Maybe [[Char]])
loadStackDBPaths
               (Bool
True, Bool
True) -> [Char] -> Haskintex (Maybe [[Char]])
forall a. [Char] -> StateT Conf IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Haskintex (Maybe [[Char]]))
-> [Char] -> Haskintex (Maybe [[Char]])
forall a b. (a -> b) -> a -> b
$ [Char]
"Found both cabal sandbox and stack project. Please, specify which package DB to use with either "
                 [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" '-cabaldb' or '-stackdb' flags."
               (Bool
False, Bool
False) -> do
                 [Char] -> Haskintex ()
outputStr [Char]
"No sandbox or stack project detected."
                 Maybe [[Char]] -> Haskintex (Maybe [[Char]])
forall a. a -> StateT Conf IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [[Char]]
forall a. Maybe a
Nothing

-- | Generate CLI arguments for GHC for package DB using cabal sandbox
loadCabalSandboxDBPaths :: Haskintex (Maybe [String])
loadCabalSandboxDBPaths :: Haskintex (Maybe [[Char]])
loadCabalSandboxDBPaths = do
  [Char] -> Haskintex ()
outputStr [Char]
"Using cabal sandbox for package db"
  [[Char]]
sand <- IO [[Char]] -> StateT Conf IO [[Char]]
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [[Char]] -> StateT Conf IO [[Char]])
-> IO [[Char]] -> StateT Conf IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [[Char]]
getDirectoryContents [Char]
".cabal-sandbox"
  let pkgdbs :: [[Char]]
pkgdbs = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [Char]
"packages.conf.d") [[Char]]
sand
  case [[Char]]
pkgdbs of
    [Char]
pkgdb : [[Char]]
_ -> do
      [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Using sandbox package db: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
pkgdb
      Maybe [[Char]] -> Haskintex (Maybe [[Char]])
forall a. a -> StateT Conf IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [[Char]] -> Haskintex (Maybe [[Char]]))
-> ([[Char]] -> Maybe [[Char]])
-> [[Char]]
-> Haskintex (Maybe [[Char]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just ([[Char]] -> Haskintex (Maybe [[Char]]))
-> [[Char]] -> Haskintex (Maybe [[Char]])
forall a b. (a -> b) -> a -> b
$ [[Char]
".cabal-sandbox/" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
pkgdb]
    [[Char]]
_ -> do
      [Char] -> Haskintex ()
outputStr [Char]
"Don't use sandbox. Empty .cabal-sandbox"
      Maybe [[Char]] -> Haskintex (Maybe [[Char]])
forall a. a -> StateT Conf IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [[Char]]
forall a. Maybe a
Nothing

-- | Generate CLI arguments for GHC for package DB using stack environment
loadStackDBPaths :: Haskintex (Maybe [String])
loadStackDBPaths :: Haskintex (Maybe [[Char]])
loadStackDBPaths = do
  [Char] -> Haskintex ()
outputStr [Char]
"Using stack environment for package db"
  let getDBPath :: [Char] -> t IO [Char]
getDBPath [Char]
s = ShowS -> t IO [Char] -> t IO [Char]
forall a b. (a -> b) -> t IO a -> t IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')) (t IO [Char] -> t IO [Char])
-> (IO [Char] -> t IO [Char]) -> IO [Char] -> t IO [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [Char] -> t IO [Char]
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [Char] -> t IO [Char]) -> IO [Char] -> t IO [Char]
forall a b. (a -> b) -> a -> b
$ CreateProcess -> [Char] -> IO [Char]
readCreateProcess ([Char] -> CreateProcess
shell ([Char] -> CreateProcess) -> [Char] -> CreateProcess
forall a b. (a -> b) -> a -> b
$ [Char]
"stack path --" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s) [Char]
""
  [Char]
pkgdbSnapshot <- [Char] -> StateT Conf IO [Char]
forall {t :: (* -> *) -> * -> *}.
(Functor (t IO), MonadTrans t) =>
[Char] -> t IO [Char]
getDBPath [Char]
"snapshot-pkg-db"
  [Char]
pkgdbGlobal <- [Char] -> StateT Conf IO [Char]
forall {t :: (* -> *) -> * -> *}.
(Functor (t IO), MonadTrans t) =>
[Char] -> t IO [Char]
getDBPath [Char]
"global-pkg-db"
  [Char]
pkgdbLocal <- [Char] -> StateT Conf IO [Char]
forall {t :: (* -> *) -> * -> *}.
(Functor (t IO), MonadTrans t) =>
[Char] -> t IO [Char]
getDBPath [Char]
"local-pkg-db"
  [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Using sandbox package db: \n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unlines [[Char]
pkgdbSnapshot, [Char]
pkgdbGlobal, [Char]
pkgdbLocal]
  Maybe [[Char]] -> Haskintex (Maybe [[Char]])
forall a. a -> StateT Conf IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [[Char]] -> Haskintex (Maybe [[Char]]))
-> ([[Char]] -> Maybe [[Char]])
-> [[Char]]
-> Haskintex (Maybe [[Char]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> Maybe [[Char]]
forall a. a -> Maybe a
Just ([[Char]] -> Haskintex (Maybe [[Char]]))
-> [[Char]] -> Haskintex (Maybe [[Char]])
forall a b. (a -> b) -> a -> b
$ [[Char]
pkgdbSnapshot, [Char]
pkgdbGlobal, [Char]
pkgdbLocal]

-- | Try to detect cabal sandbox and use stack's ones if user specifies the 'stackdb' flag.
getSandbox :: Haskintex (Maybe [String])
getSandbox :: Haskintex (Maybe [[Char]])
getSandbox = do
  Maybe PackageDB
pkgDbConf <- Conf -> Maybe PackageDB
packageDb (Conf -> Maybe PackageDB)
-> StateT Conf IO Conf -> StateT Conf IO (Maybe PackageDB)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
  case Maybe PackageDB
pkgDbConf of
    Maybe PackageDB
Nothing -> Haskintex (Maybe [[Char]])
autoDetectSandbox
    Just PackageDB
CabalSandboxDB -> Haskintex (Maybe [[Char]])
loadCabalSandboxDBPaths
    Just PackageDB
StackDB -> Haskintex (Maybe [[Char]])
loadStackDBPaths

memoreduce :: Typeable t
           => String -- ^ Auxiliar module name
           -> Bool -- ^ Is this expression memorized?
           -> Text -- ^ Input
           -> t -- ^ Type
           -> (t -> Haskintex Text) -- ^ Rendering function
           -> Haskintex Text
memoreduce :: forall t.
Typeable t =>
[Char]
-> Bool -> Text -> t -> (t -> Haskintex Text) -> Haskintex Text
memoreduce [Char]
modName Bool
isMemo Text
t t
ty t -> Haskintex Text
f = do
  let e :: [Char]
e = Text -> [Char]
unpack Text
t
  [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Evaluation (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> ShowS
showsTypeRep (Maybe t -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Maybe t -> TypeRep) -> Maybe t -> TypeRep
forall a b. (a -> b) -> a -> b
$ t -> Maybe t
forall a. a -> Maybe a
Just t
ty) [Char]
"" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"): " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
e
  MemoTree
memt <- Conf -> MemoTree
memoTree (Conf -> MemoTree)
-> StateT Conf IO Conf -> StateT Conf IO MemoTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let p :: Maybe Text
p = if Bool
isMemo then Text -> MemoTree -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
t MemoTree
memt else Maybe Text
forall a. Maybe a
Nothing
  case Maybe Text
p of
    Maybe Text
Nothing -> do
      let int :: InterpreterT Haskintex t
int = do
             [[Char]] -> InterpreterT Haskintex ()
forall (m :: * -> *). MonadInterpreter m => [[Char]] -> m ()
loadModules [[Char]
modName]
             [[Char]] -> InterpreterT Haskintex ()
forall (m :: * -> *). MonadInterpreter m => [[Char]] -> m ()
setTopLevelModules [[Char]
modName]
             [[Char]] -> InterpreterT Haskintex ()
forall (m :: * -> *). MonadInterpreter m => [[Char]] -> m ()
setImports [[Char]
"Prelude"]
             [Char] -> t -> InterpreterT Haskintex t
forall (m :: * -> *) a.
(MonadInterpreter m, Typeable a) =>
[Char] -> a -> m a
interpret [Char]
e t
ty
      -- Sandbox recognition and executing interpreter
      Either InterpreterError t
r <- StateT Conf IO (Either InterpreterError t)
-> ([[Char]] -> StateT Conf IO (Either InterpreterError t))
-> Maybe [[Char]]
-> StateT Conf IO (Either InterpreterError t)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InterpreterT Haskintex t
-> StateT Conf IO (Either InterpreterError t)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
InterpreterT m a -> m (Either InterpreterError a)
runInterpreter InterpreterT Haskintex t
int) (\[[Char]]
pkgdbs -> [[Char]]
-> InterpreterT Haskintex t
-> StateT Conf IO (Either InterpreterError t)
forall (m :: * -> *) a.
(MonadMask m, MonadIO m) =>
[[Char]] -> InterpreterT m a -> m (Either InterpreterError a)
unsafeRunInterpreterWithArgs (([Char]
"-package-db " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> [[Char]] -> [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Char]]
pkgdbs) InterpreterT Haskintex t
int) (Maybe [[Char]] -> StateT Conf IO (Either InterpreterError t))
-> Haskintex (Maybe [[Char]])
-> StateT Conf IO (Either InterpreterError t)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Haskintex (Maybe [[Char]])
getSandbox
      case Either InterpreterError t
r of
        Left InterpreterError
err -> do
          Bool
shouldFail <- Conf -> Bool
werrorFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
          if Bool
shouldFail
            then [Char] -> Haskintex ()
forall a. [Char] -> StateT Conf IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: failed while evaluating the expression: \n"
                   [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ InterpreterError -> [Char]
errorString InterpreterError
err
            else [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Warning: Error while evaluating the expression.\n"
                   [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ InterpreterError -> [Char]
errorString InterpreterError
err
          Text -> Haskintex Text
forall a. a -> StateT Conf IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
forall a. Monoid a => a
mempty
        Right t
x -> do
          -- Render result
          Text
t' <- t -> Haskintex Text
f t
x
          -- If the expression is marked to be memorized, store it in the 'MemoTree'.
          Bool -> Haskintex () -> Haskintex ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isMemo (Haskintex () -> Haskintex ()) -> Haskintex () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ do
            (Conf -> Conf) -> Haskintex ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Conf -> Conf) -> Haskintex ()) -> (Conf -> Conf) -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ \Conf
st -> Conf
st { memoTree = M.insert t t' $ memoTree st }
            [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"-> Result has been memorized."
          -- Return result
          Text -> Haskintex Text
forall a. a -> StateT Conf IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t'
    Just Text
o -> do
      [Char] -> Haskintex ()
outputStr [Char]
"-> Result of the evaluation recovered from memo tree."
      Text -> Haskintex Text
forall a. a -> StateT Conf IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
o

{- Memo Tree Format

A memo tree is stored as a list of (key,value) in key ascending order.
Keys and values are encoded in UTF-8.

| offset |   description        | size (in bytes) |
---------------------------------------------------
| 00     | Number of blocks     | 2               |
| 02     | Zero or more blocks  | variable        |

Each block has the following structure:

| offset |   description        | size (in bytes) |
---------------------------------------------------
| 00     | Length of key (k)    | 2               |
| 02     | Length of value (v)  | 2               |
| 04     | Key                  | k               |
| 04+k   | Value                | v               |

-}

memoTreeToBinary :: MemoTree -> ByteString
memoTreeToBinary :: MemoTree -> ByteString
memoTreeToBinary MemoTree
memt = Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ do
  Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ MemoTree -> Int
forall k a. Map k a -> Int
M.size MemoTree
memt
  ((Text, Text) -> Put) -> [(Text, Text)] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Text
t,Text
t') -> do
    let b :: ByteString
b  = Text -> ByteString
encodeUtf8 Text
t
        b' :: ByteString
b' = Text -> ByteString
encodeUtf8 Text
t'
    Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
SB.length ByteString
b
    Word16 -> Put
putWord16le (Word16 -> Put) -> Word16 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
SB.length ByteString
b'
    ByteString -> Put
putByteString ByteString
b
    ByteString -> Put
putByteString ByteString
b'
    ) ([(Text, Text)] -> Put) -> [(Text, Text)] -> Put
forall a b. (a -> b) -> a -> b
$ MemoTree -> [(Text, Text)]
forall k a. Map k a -> [(k, a)]
M.toAscList MemoTree
memt

memoTreeFromBinary :: ByteString -> Either String MemoTree
memoTreeFromBinary :: ByteString -> Either [Char] MemoTree
memoTreeFromBinary ByteString
b =
  case Get MemoTree
-> ByteString
-> Either (ByteString, Int64, [Char]) (ByteString, Int64, MemoTree)
forall a.
Get a
-> ByteString
-> Either (ByteString, Int64, [Char]) (ByteString, Int64, a)
runGetOrFail Get MemoTree
getMemoTree ByteString
b of
    Left (ByteString
_,Int64
_,[Char]
err) -> [Char] -> Either [Char] MemoTree
forall a b. a -> Either a b
Left [Char]
err
    Right (ByteString
_,Int64
_,MemoTree
memt) -> MemoTree -> Either [Char] MemoTree
forall a b. b -> Either a b
Right MemoTree
memt

getMemoTree :: Get MemoTree
getMemoTree :: Get MemoTree
getMemoTree = do
  Int
n <- Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Get Word16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word16
getWord16le
  ([(Text, Text)] -> MemoTree) -> Get [(Text, Text)] -> Get MemoTree
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, Text)] -> MemoTree
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList (Get [(Text, Text)] -> Get MemoTree)
-> Get [(Text, Text)] -> Get MemoTree
forall a b. (a -> b) -> a -> b
$ Int -> Get (Text, Text) -> Get [(Text, Text)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n (Get (Text, Text) -> Get [(Text, Text)])
-> Get (Text, Text) -> Get [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ do
    Word16
l  <- Get Word16
getWord16le
    Word16
l' <- Get Word16
getWord16le
    ByteString
b  <- Int -> Get ByteString
getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
l
    ByteString
b' <- Int -> Get ByteString
getByteString (Int -> Get ByteString) -> Int -> Get ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
l'
    (Text, Text) -> Get (Text, Text)
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Text
decodeUtf8 ByteString
b, ByteString -> Text
decodeUtf8 ByteString
b')

memoTreeOpen :: Haskintex ()
memoTreeOpen :: Haskintex ()
memoTreeOpen = do
  [Char]
d <- IO [Char] -> StateT Conf IO [Char]
forall a. IO a -> StateT Conf IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> StateT Conf IO [Char])
-> IO [Char] -> StateT Conf IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
getAppUserDataDirectory [Char]
"haskintex"
  let fp :: [Char]
fp = [Char]
d [Char] -> ShowS
</> [Char]
"memotree"
  Bool
b <- IO Bool -> StateT Conf IO Bool
forall a. IO a -> StateT Conf IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> StateT Conf IO Bool) -> IO Bool -> StateT Conf IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
fp
  if Bool
b then do ByteString
t <- IO ByteString -> StateT Conf IO ByteString
forall a. IO a -> StateT Conf IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> StateT Conf IO ByteString)
-> IO ByteString -> StateT Conf IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ByteString
LB.readFile [Char]
fp
               case ByteString -> Either [Char] MemoTree
memoTreeFromBinary ByteString
t of
                 Left [Char]
err -> do
                   [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Error: memotree failed to read: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
err
                   [Char] -> Haskintex ()
outputStr [Char]
"-> Using empty memotree."
                   (Conf -> Conf) -> Haskintex ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Conf -> Conf) -> Haskintex ()) -> (Conf -> Conf) -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ \Conf
st -> Conf
st { memoTree = M.empty }
                 Right MemoTree
memt -> do
                   (Conf -> Conf) -> Haskintex ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Conf -> Conf) -> Haskintex ()) -> (Conf -> Conf) -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ \Conf
st -> Conf
st { memoTree = memt }
                   let n :: Int64
n = ByteString -> Int64
LB.length ByteString
t
                       kbs :: Double
                       kbs :: Double
kbs = Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1024
                       s :: [Char]
s = if Double
kbs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 then Int64 -> [Char]
forall a. Show a => a -> [Char]
show Int64
n [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" Bs"
                                      else Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2) Double
kbs [Char]
" KBs"
                   [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Info: memotree loaded (" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")."
       else do [Char] -> Haskintex ()
outputStr [Char]
"Info: memotree does not exist."
               [Char] -> Haskintex ()
outputStr [Char]
"-> Using empty memotree."
               (Conf -> Conf) -> Haskintex ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Conf -> Conf) -> Haskintex ()) -> (Conf -> Conf) -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ \Conf
st -> Conf
st { memoTree = M.empty }

memoTreeSave :: Haskintex ()
memoTreeSave :: Haskintex ()
memoTreeSave = do
  MemoTree
memt <- Conf -> MemoTree
memoTree (Conf -> MemoTree)
-> StateT Conf IO Conf -> StateT Conf IO MemoTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
  Bool -> Haskintex () -> Haskintex ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (MemoTree -> Bool
forall k a. Map k a -> Bool
M.null MemoTree
memt) (Haskintex () -> Haskintex ()) -> Haskintex () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> Haskintex ()
outputStr [Char]
"Saving memotree..."
    IO () -> Haskintex ()
forall a. IO a -> StateT Conf IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Haskintex ()) -> IO () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ do
      [Char]
d <- [Char] -> IO [Char]
getAppUserDataDirectory [Char]
"haskintex"
      Bool -> [Char] -> IO ()
createDirectoryIfMissing Bool
True [Char]
d
      let fp :: [Char]
fp = [Char]
d [Char] -> ShowS
</> [Char]
"memotree"
      [Char] -> ByteString -> IO ()
LB.writeFile [Char]
fp (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ MemoTree -> ByteString
memoTreeToBinary MemoTree
memt
    [Char] -> Haskintex ()
outputStr [Char]
"Info: memotree saved."

memoTreeClean :: Haskintex ()
memoTreeClean :: Haskintex ()
memoTreeClean = do
  [Char]
d <- IO [Char] -> StateT Conf IO [Char]
forall a. IO a -> StateT Conf IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Char] -> StateT Conf IO [Char])
-> IO [Char] -> StateT Conf IO [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> IO [Char]
getAppUserDataDirectory [Char]
"haskintex"
  let fp :: [Char]
fp = [Char]
d [Char] -> ShowS
</> [Char]
"memotree"
  Bool
b <- IO Bool -> StateT Conf IO Bool
forall a. IO a -> StateT Conf IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> StateT Conf IO Bool) -> IO Bool -> StateT Conf IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
fp
  Bool -> Haskintex () -> Haskintex ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (Haskintex () -> Haskintex ()) -> Haskintex () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ do
    IO () -> Haskintex ()
forall a. IO a -> StateT Conf IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Haskintex ()) -> IO () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
removeFile [Char]
fp
    [Char] -> Haskintex ()
outputStr [Char]
"Info: memotree removed."

----------------------------------------------------------

-- PASS 1: Extract code from processed Syntax.

extractCode :: Syntax -> (Text,Text)
extractCode :: Syntax -> (Text, Text)
extractCode (WriteHaskell Bool
_ Bool
isH Text
t) = if Bool
isH then (Text
t,Text
forall a. Monoid a => a
mempty) else (Text
forall a. Monoid a => a
mempty,Text
t)
extractCode (Sequence [Syntax]
xs) = (Syntax -> (Text, Text)) -> [Syntax] -> (Text, Text)
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Syntax -> (Text, Text)
extractCode [Syntax]
xs
extractCode Syntax
_ = (Text, Text)
forall a. Monoid a => a
mempty

-- PASS 2: Evaluate Haskell expressions from processed Syntax.

evalCode :: String -- ^ Auxiliary module name
         -> Syntax -> Haskintex Text
evalCode :: [Char] -> Syntax -> Haskintex Text
evalCode [Char]
modName = Syntax -> Haskintex Text
go
  where
    go :: Syntax -> Haskintex Text
go (WriteLaTeX Text
t) = Text -> Haskintex Text
forall a. a -> StateT Conf IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
t
    go (WriteHaskell Bool
b Bool
_ Text
t) = do
         Bool
mFlag <- Conf -> Bool
manualFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
         Bool
lhsFlag <- Conf -> Bool
lhs2texFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
         let f :: Text -> LaTeX
             f :: Text -> LaTeX
f Text
x | Bool -> Bool
not Bool
b = LaTeX
forall a. Monoid a => a
mempty
                 | Bool
mFlag = Text -> LaTeX
forall l. LaTeXC l => Text -> l
raw Text
x
                 | Bool
lhsFlag = [Char] -> [TeXArg] -> LaTeX -> LaTeX
TeXEnv [Char]
"code" [] (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ Text -> LaTeX
forall l. LaTeXC l => Text -> l
raw Text
x
                 | Bool
otherwise = Text -> LaTeX
forall l. LaTeXC l => Text -> l
verbatim Text
x
         Text -> Haskintex Text
forall a. a -> StateT Conf IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Haskintex Text) -> Text -> Haskintex Text
forall a b. (a -> b) -> a -> b
$ LaTeX -> Text
forall a. Render a => a -> Text
render (LaTeX -> Text) -> LaTeX -> Text
forall a b. (a -> b) -> a -> b
$ Text -> LaTeX
f Text
t
    go (InsertHaTeX   Bool
isMemo Text
t) = [Char]
-> Bool
-> Text
-> LaTeX
-> (LaTeX -> Haskintex Text)
-> Haskintex Text
forall t.
Typeable t =>
[Char]
-> Bool -> Text -> t -> (t -> Haskintex Text) -> Haskintex Text
memoreduce [Char]
modName Bool
isMemo Text
t (LaTeX
forall a. Typeable a => a
as ::    LaTeX) (Text -> Haskintex Text
forall a. a -> StateT Conf IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Haskintex Text)
-> (LaTeX -> Text) -> LaTeX -> Haskintex Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.      LaTeX -> Text
forall a. Render a => a -> Text
render)
    go (InsertHaTeXIO Bool
isMemo Text
t) = [Char]
-> Bool
-> Text
-> IO LaTeX
-> (IO LaTeX -> Haskintex Text)
-> Haskintex Text
forall t.
Typeable t =>
[Char]
-> Bool -> Text -> t -> (t -> Haskintex Text) -> Haskintex Text
memoreduce [Char]
modName Bool
isMemo Text
t (IO LaTeX
forall a. Typeable a => a
as :: IO LaTeX) (IO Text -> Haskintex Text
forall a. IO a -> StateT Conf IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> Haskintex Text)
-> (IO LaTeX -> IO Text) -> IO LaTeX -> Haskintex Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LaTeX -> Text) -> IO LaTeX -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LaTeX -> Text
forall a. Render a => a -> Text
render)
    go (EvalHaskell Bool
env Bool
isMemo Text
t) = do
         Bool
mFlag <- Conf -> Bool
manualFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
         Bool
lhsFlag <- Conf -> Bool
lhs2texFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
         let f :: Text -> LaTeX
             f :: Text -> LaTeX
f Text
x | Bool
mFlag = Text -> LaTeX
forall l. LaTeXC l => Text -> l
raw Text
x -- Manual flag overrides lhs2tex flag behavior
                 | Bool
env Bool -> Bool -> Bool
&& Bool
lhsFlag = [Char] -> [TeXArg] -> LaTeX -> LaTeX
TeXEnv [Char]
"code" [] (LaTeX -> LaTeX) -> LaTeX -> LaTeX
forall a b. (a -> b) -> a -> b
$ Text -> LaTeX
forall l. LaTeXC l => Text -> l
raw Text
x
                 | Bool
lhsFlag = Text -> LaTeX
forall l. LaTeXC l => Text -> l
raw (Text -> LaTeX) -> Text -> LaTeX
forall a b. (a -> b) -> a -> b
$ Text
"|" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"|"
                 | Bool
env = Text -> LaTeX
forall l. LaTeXC l => Text -> l
verbatim (Text -> LaTeX) -> Text -> LaTeX
forall a b. (a -> b) -> a -> b
$ Text -> Text
layout Text
x
                 | Bool
otherwise = Text -> LaTeX
forall l. LaTeXC l => Text -> l
verb Text
x
         (LaTeX -> Text
forall a. Render a => a -> Text
render (LaTeX -> Text) -> (Text -> LaTeX) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LaTeX
f) (Text -> Text) -> Haskintex Text -> Haskintex Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Bool -> Text -> Haskintex Text
ghc [Char]
modName Bool
isMemo Text
t
    go (Sequence [Syntax]
xs) = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> StateT Conf IO [Text] -> Haskintex Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Syntax -> Haskintex Text) -> [Syntax] -> StateT Conf IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Syntax -> Haskintex Text
go [Syntax]
xs

ghc :: String -> Bool -> Text -> Haskintex Text
ghc :: [Char] -> Bool -> Text -> Haskintex Text
ghc [Char]
modName Bool
isMemo Text
t = do
  let e :: [Char]
e = Text -> [Char]
unpack Text
t
  [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Evaluation: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
e
  MemoTree
memt <- Conf -> MemoTree
memoTree (Conf -> MemoTree)
-> StateT Conf IO Conf -> StateT Conf IO MemoTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
  let p :: Maybe Text
p = if Bool
isMemo then Text -> MemoTree -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
t MemoTree
memt else Maybe Text
forall a. Maybe a
Nothing
  case Maybe Text
p of
    Maybe Text
Nothing -> do
      Bool
useStack <- (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall a b. (a -> b) -> StateT Conf IO a -> StateT Conf IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> (PackageDB -> Bool) -> Maybe PackageDB -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False PackageDB -> Bool
isStackDB (Maybe PackageDB -> Bool)
-> (Conf -> Maybe PackageDB) -> Conf -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Conf -> Maybe PackageDB
packageDb) StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
      -- Run GHC externally and read the result.
      Text
r <- if Bool
useStack
        then IO Text -> Haskintex Text
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Text -> Haskintex Text) -> IO Text -> Haskintex Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack ([Char] -> Text) -> ShowS -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. HasCallStack => [a] -> [a]
init ([Char] -> Text) -> IO [Char] -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> [Char] -> IO [Char]
readProcess [Char]
"stack"
                -- Disable reading of .ghci files.
                [[Char]
"ghc", [Char]
"--", [Char]
"-ignore-dot-ghci", 
                -- Evaluation loading the temporal module.
                [Char]
modName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".hs"
                , [Char]
"-e", [Char]
e ] []
        else IO Text -> Haskintex Text
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Text -> Haskintex Text) -> IO Text -> Haskintex Text
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
pack ([Char] -> Text) -> ShowS -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. HasCallStack => [a] -> [a]
init ([Char] -> Text) -> IO [Char] -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> [[Char]] -> [Char] -> IO [Char]
readProcess [Char]
"ghc"
                -- Disable reading of .ghci files.
                [[Char]
"-ignore-dot-ghci", 
                -- Evaluation loading the temporal module.
                [Char]
modName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".hs"
                , [Char]
"-e", [Char]
e ] []
      -- If the expression is marked to be memorized, we do so.
      Bool -> Haskintex () -> Haskintex ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isMemo (Haskintex () -> Haskintex ()) -> Haskintex () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ do
         (Conf -> Conf) -> Haskintex ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify ((Conf -> Conf) -> Haskintex ()) -> (Conf -> Conf) -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ \Conf
st -> Conf
st { memoTree = M.insert t r $ memoTree st }
         [Char] -> Haskintex ()
outputStr [Char]
"-> Result has been memorized."
      -- Return result
      Text -> Haskintex Text
forall a. a -> StateT Conf IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
r
    Just Text
o -> do
      [Char] -> Haskintex ()
outputStr [Char]
"-> Result of the evaluation recovered from memo tree."
      Text -> Haskintex Text
forall a. a -> StateT Conf IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
o

maxLineLength :: Int
maxLineLength :: Int
maxLineLength = Int
60

-- | Break lines longer than 'maxLineLenght'.
layout :: Text -> Text
layout :: Text -> Text
layout = [Text] -> Text
T.unlines ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
go ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
  where
    go :: [Text] -> [Text]
go [] = []
    go (Text
t:[Text]
ts) =
      if Text -> Int
T.length Text
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxLineLength
         then let (Text
l,Text
r) = Int -> Text -> (Text, Text)
T.splitAt Int
maxLineLength Text
t
              in  Text
l Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go (Text
rText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
ts)
         else Text
t Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text] -> [Text]
go [Text]
ts

-- Errors

errorString :: InterpreterError -> String
errorString :: InterpreterError -> [Char]
errorString (UnknownError [Char]
e) = [Char]
"Unknown error: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
e
errorString (WontCompile [GhcError]
es) = [Char]
"Compiler error:\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. HasCallStack => [a] -> [a]
init ([[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (GhcError -> [Char]) -> [GhcError] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GhcError -> [Char]
errMsg [GhcError]
es)
errorString (NotAllowed [Char]
e) = [Char]
"Not allowed:" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
e
errorString (GhcException [Char]
e) = [Char]
"GHC exception: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
e

-- Haskintex main function

-- | Run haskintex with the given arguments. For example:
--
-- > haskintex ["-visible","-overwrite","foo.htex"]
--
--   Useful if you want to call /haskintex/ from another program.
--
haskintex :: [String] -> IO ()
haskintex :: [[Char]] -> IO ()
haskintex = Haskintex () -> Conf -> IO ()
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT Haskintex ()
haskintexmain (Conf -> IO ()) -> ([[Char]] -> Conf) -> [[Char]] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> Conf
readConf

haskintexmain :: Haskintex ()
haskintexmain :: Haskintex ()
haskintexmain = do
  Conf
flags <- StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
  if -- If the help flag is passed, ignore everything else
     -- and just print the help.
     Conf -> Bool
helpFlag Conf
flags
     then IO () -> Haskintex ()
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Haskintex ()) -> IO () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr [Char]
help
     else let xs :: [[Char]]
xs = Conf -> [[Char]]
inputs Conf
flags
          in  if [[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
xs
                 then IO () -> Haskintex ()
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Haskintex ()) -> IO () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr [Char]
noFiles
                 else do Haskintex ()
memoTreeOpen
                         ([Char] -> Haskintex ()) -> [[Char]] -> Haskintex ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> Haskintex ()
haskintexFile [[Char]]
xs
                         Bool
willClean <- Conf -> Bool
memocleanFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
                         if Bool
willClean then Haskintex ()
memoTreeClean else Haskintex ()
memoTreeSave

commas :: [String] -> String
commas :: [[Char]] -> [Char]
commas = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
intersperse [Char]
", "

showEnabledFlags :: Haskintex ()
showEnabledFlags :: Haskintex ()
showEnabledFlags = do
  Conf
c <- StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
  [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Enabled flags: "
           [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
commas ((([Char], Conf -> Bool) -> [[Char]] -> [[Char]])
-> [[Char]] -> [([Char], Conf -> Bool)] -> [[Char]]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\([Char]
str,Conf -> Bool
f) [[Char]]
xs -> if Conf -> Bool
f Conf
c then [Char]
str [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: [[Char]]
xs else [[Char]]
xs) [] [([Char], Conf -> Bool)]
supportedFlags)
           [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."

reportWarnings :: Haskintex ()
reportWarnings :: Haskintex ()
reportWarnings = do
  -- Combination of manual and lhs2tex flags.
  Bool
manFlag <- Conf -> Bool
manualFlag  (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
  Bool
lhsFlag <- Conf -> Bool
lhs2texFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
  Bool -> Haskintex () -> Haskintex ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
manFlag Bool -> Bool -> Bool
&& Bool
lhsFlag) (Haskintex () -> Haskintex ()) -> Haskintex () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> Haskintex ()
outputStr [Char]
"Warning: lhs2tex flag is useless in presence of manual flag."

haskintexFile :: FilePath -> Haskintex ()
haskintexFile :: [Char] -> Haskintex ()
haskintexFile [Char]
fp_ = do
  -- If the given file does not exist, try adding '.htex'.
  Bool
b <- IO Bool -> StateT Conf IO Bool
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Bool -> StateT Conf IO Bool) -> IO Bool -> StateT Conf IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
fp_
  let fp :: [Char]
fp = if Bool
b then [Char]
fp_ else [Char]
fp_ [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".htex"
  -- Report enabled flags
  Haskintex ()
showEnabledFlags
  -- Warnings
  Haskintex ()
reportWarnings
  -- Other unknown flags passed.
  [[Char]]
uFlags <- Conf -> [[Char]]
unknownFlags (Conf -> [[Char]])
-> StateT Conf IO Conf -> StateT Conf IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
  Bool -> Haskintex () -> Haskintex ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
uFlags) (Haskintex () -> Haskintex ()) -> Haskintex () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Unsupported flags: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
commas [[Char]]
uFlags [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."
  -- File parsing.
  [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Reading " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fp [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"..."
  Text
t <- IO Text -> Haskintex Text
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Text -> Haskintex Text) -> IO Text -> Haskintex Text
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Text
T.readFile [Char]
fp
  Either ParseError Syntax
pres <- Parser Syntax
-> ()
-> [Char]
-> Text
-> StateT Conf IO (Either ParseError Syntax)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> [Char] -> s -> m (Either ParseError a)
runParserT Parser Syntax
parseSyntax () [Char]
fp Text
t
  case Either ParseError Syntax
pres of
    Left ParseError
err -> [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Reading of " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fp [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" failed:\n" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
err
    Right Syntax
s -> do
      -- Zero pass: In case of debugging, write down the parsed AST.
      Bool
dbugFlag <- Conf -> Bool
debugFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
      Bool -> Haskintex () -> Haskintex ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
dbugFlag (Haskintex () -> Haskintex ()) -> Haskintex () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ do
        let debugfp :: [Char]
debugfp = ShowS
dropExtension (ShowS
takeFileName [Char]
fp) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".debughtex"
        [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Writing file " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
debugfp [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" with debugging output..."
        IO () -> Haskintex ()
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Haskintex ()) -> IO () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
writeFile [Char]
debugfp ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Syntax -> [Char]
forall a. Show a => a -> [Char]
show Syntax
s
      -- First pass: Create haskell source from the code obtained with 'extractCode'.
      let modName :: [Char]
modName = ([Char]
"Haskintex_" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
dropExtension ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
takeFileName [Char]
fp
      [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Creating Haskell source file " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
modName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".hs..."
      let (Text
hsH,Text
hs) = Syntax -> (Text, Text)
extractCode Syntax
s
          moduleHeader :: Text
moduleHeader = [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"\nmodule " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
modName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" where\n\n"
      IO () -> Haskintex ()
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Haskintex ()) -> IO () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text -> IO ()
T.writeFile ([Char]
modName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".hs") (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
hsH Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
moduleHeader Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
hs
      -- Second pass: Evaluate expressions using 'evalCode'.
      [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Evaluating expressions in " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fp [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"..."
      Text
l <- [Char] -> Syntax -> Haskintex Text
evalCode [Char]
modName Syntax
s
      -- Write final output.
      let fp' :: [Char]
fp' = ShowS
dropExtension (ShowS
takeFileName [Char]
fp) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".tex"
          writeit :: Haskintex ()
writeit = do [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Writing final file at " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fp' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"..."
                       IO () -> Haskintex ()
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Haskintex ()) -> IO () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text -> IO ()
T.writeFile [Char]
fp' Text
l
      Bool
outFlag <- Conf -> Bool
stdoutFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
      Bool
overFlag <- Conf -> Bool
overwriteFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
      Bool
nonew <- IO Bool -> StateT Conf IO Bool
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Bool -> StateT Conf IO Bool) -> IO Bool -> StateT Conf IO Bool
forall a b. (a -> b) -> a -> b
$ [Char] -> IO Bool
doesFileExist [Char]
fp'
      let finalOutput :: Haskintex ()
finalOutput
           | Bool
outFlag = do [Char] -> Haskintex ()
outputStr [Char]
"Sending final output to stdout..."
                          IO () -> Haskintex ()
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Haskintex ()) -> IO () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
T.putStr Text
l
           | Bool
overFlag = Haskintex ()
writeit
           | Bool
nonew = do IO () -> Haskintex ()
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Haskintex ()) -> IO () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"File " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fp' [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" already exists. Overwrite?"
                                     [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" (use -overwrite to overwrite by default) "
                        IO () -> Haskintex ()
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Haskintex ()) -> IO () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
stdout -- To immediately show the text on Windows systems.
                        [Char]
resp <- IO [Char] -> StateT Conf IO [Char]
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO [Char]
getLine
                        if [Char]
resp [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"",[Char]
"y",[Char]
"yes"]
                           then Haskintex ()
writeit
                           else [Char] -> Haskintex ()
outputStr [Char]
"No file was written."
           | Bool
otherwise = Haskintex ()
writeit
      Haskintex ()
finalOutput
      -- If the keep flag is not set, remove the haskell source file.
      Bool
kFlag <- Conf -> Bool
keepFlag (Conf -> Bool) -> StateT Conf IO Conf -> StateT Conf IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT Conf IO Conf
forall (m :: * -> *) s. Monad m => StateT s m s
get
      Bool -> Haskintex () -> Haskintex ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
kFlag (Haskintex () -> Haskintex ()) -> Haskintex () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ do
        [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Removing Haskell source file " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
modName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".hs "
                  [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"(use -keep to avoid this)..."
        IO () -> Haskintex ()
forall (m :: * -> *) a. Monad m => m a -> StateT Conf m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> Haskintex ()) -> IO () -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
removeFile ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
modName [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".hs"
      -- End.
      [Char] -> Haskintex ()
outputStr ([Char] -> Haskintex ()) -> [Char] -> Haskintex ()
forall a b. (a -> b) -> a -> b
$ [Char]
"End of processing of file " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
fp [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."

-- MESSAGES

help :: String
help :: [Char]
help = [[Char]] -> [Char]
unlines [
    [Char]
"You are using haskintex version " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
showVersion Version
version [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."
  , [Char]
"http://daniel-diaz.github.io/projects/haskintex"
  , [Char]
""
  , [Char]
"The underlying HaTeX version is " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
showVersion Version
Hatex.version [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"."
  , [Char]
""
  , [Char]
"Usage and flags:"
  , [Char]
"Any argument passed to haskintex that starts with '-' will be considered"
  , [Char]
"a flag. Otherwise, it will be considered an input file. Every input file"
  , [Char]
"will be processed with the same set of flags, which will include all the"
  , [Char]
"flags passed in the call. This is the list of flags supported by haskintex:"
  , [Char]
""
  , [Char]
"  -keep       haskintex creates an intermmediate Haskell file before"
  , [Char]
"              evaluating any expressions. By default, this file is "
  , [Char]
"              eliminated after processing the file. Pass this flag to"
  , [Char]
"              keep the file."
  , [Char]
""
  , [Char]
"  -visible    By default, code written inside a writehaskell environment"
  , [Char]
"              is not shown in the LaTeX output. This flag changes the"
  , [Char]
"              default."
  , [Char]
""
  , [Char]
"  -verbose    If this flag is enabled, haskintex will print information"
  , [Char]
"              about its own execution while running."
  , [Char]
""
  , [Char]
"  -manual     By default, Haskell expressions, either from writehaskell "
  , [Char]
"              or evalhaskell, appear in the LaTeX output inside verb or"
  , [Char]
"              verbatim declarations. If this flag is passed, neither verb"
  , [Char]
"              nor verbatim will be used. The code will be written as text "
  , [Char]
"              as it is. The user will decide how to handle it."
  , [Char]
""
  , [Char]
"  -help       This flags cancels any other flag or input file and makes"
  , [Char]
"              the program simply show this help message."
  , [Char]
""
  , [Char]
"  -stdout     Instead of writing the output to a file, send it to the"
  , [Char]
"              standard output stream (stdout)."
  , [Char]
""
  , [Char]
"  -lhs2tex    Instead of using verb or verbatim declarations, format the"
  , [Char]
"              output using the syntax accepted by lhs2TeX."
  , [Char]
""
  , [Char]
"  -overwrite  Overwrite the output file if it already exists. If this flag"
  , [Char]
"              is not set, the program will ask before overwriting."
  , [Char]
""
  , [Char]
"  -debug      Only for debugging purposes. It writes a file with extension"
  , [Char]
"              .debughtex with the AST of the internal representation of the"
  , [Char]
"              input file haskintex uses."
  , [Char]
""
  , [Char]
"  -memo       Unless otherwise specified, every evalhaskell, hatex or iohatex"
  , [Char]
"              command (or environment) will be called with the memo option."
  , [Char]
""
  , [Char]
"  -memoclean  Cleans the memo tree after the execution of haskintex. If "
  , [Char]
"              several files are processed, the memo tree will be cleaned"
  , [Char]
"              after processing all of them."
  , [Char]
""
  , [Char]
"  -autotexy   Apply the function texy from HaTeX to every expression in a hatex"
  , [Char]
"              or iohatex command. This effectively allows the user to write"
  , [Char]
"              expressions in types other than LaTeX and have haskintex to perform"
  , [Char]
"              the required transformation."
  , [Char]
""
  , [Char]
"  -nosandbox  Do not use a sandbox package db even in the presence of one."
  , [Char]
""
  , [Char]
"  -cabaldb    Use local cabal sandbox."
  , [Char]
""
  , [Char]
"  -stackdb    Use local stackage db."
  , [Char]
""
  , [Char]
"Any unsupported flag will be ignored."
  ]

noFiles :: String
noFiles :: [Char]
noFiles = [Char]
"No input file given.\n"