module Common.PrintLaTeX
( renderLatex
, latexHeader
, latexFooter
)
where
import Data.Char (isSpace, isDigit)
import Common.Lib.State
import Data.List (isPrefixOf, isSuffixOf)
import Data.Maybe (fromMaybe)
import Common.Lib.Pretty
import Common.LaTeX_funs
latexHeader :: String
= [String] -> String
unlines
[ "\\documentclass{article}"
, "\\usepackage{hetcasl}"
, "\\usepackage{textcomp}"
, "\\usepackage[T1]{fontenc}"
, "\\begin{document}" ]
latexFooter :: String
= "\n\\end{document}\n"
latexStyle :: Style
latexStyle :: Style
latexStyle = Style
style
{ ribbonsPerLine :: Float
ribbonsPerLine = 1.1
, lineLength :: Int
lineLength = Int -> Int
calcLineLen 345 }
data LRState = LRS
{ LRState -> [Int]
indentTabs :: ![Int]
, LRState -> Int
recentlySet
, LRState -> Int
totalTabStops
, LRState -> Int
setTabsThisLine
, LRState -> Int
indentTabsWritten :: !Int
, LRState -> Bool
onlyTabs :: !Bool
, LRState -> Bool
isSetLine :: !Bool
, LRState -> [Int]
collSpaceIndents :: ![Int]
, LRState -> Bool
insideAnno :: Bool
} deriving Int -> LRState -> ShowS
[LRState] -> ShowS
LRState -> String
(Int -> LRState -> ShowS)
-> (LRState -> String) -> ([LRState] -> ShowS) -> Show LRState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LRState] -> ShowS
$cshowList :: [LRState] -> ShowS
show :: LRState -> String
$cshow :: LRState -> String
showsPrec :: Int -> LRState -> ShowS
$cshowsPrec :: Int -> LRState -> ShowS
Show
initialLRState :: LRState
initialLRState :: LRState
initialLRState = $WLRS :: [Int]
-> Int
-> Int
-> Int
-> Int
-> Bool
-> Bool
-> [Int]
-> Bool
-> LRState
LRS
{ indentTabs :: [Int]
indentTabs = []
, recentlySet :: Int
recentlySet = 0
, totalTabStops :: Int
totalTabStops = 0
, setTabsThisLine :: Int
setTabsThisLine = 0
, indentTabsWritten :: Int
indentTabsWritten = 0
, onlyTabs :: Bool
onlyTabs = Bool
False
, isSetLine :: Bool
isSetLine = Bool
False
, collSpaceIndents :: [Int]
collSpaceIndents = []
, insideAnno :: Bool
insideAnno = Bool
False
}
showTextDetails :: TextDetails -> String
showTextDetails :: TextDetails -> String
showTextDetails t :: TextDetails
t = case TextDetails
t of
Chr c :: Char
c -> [Char
c]
Str s :: String
s -> String
s
PStr s :: String
s -> String
s
maxTabs :: Int
maxTabs :: Int
maxTabs = 12
latexTxt :: TextDetails -> State LRState ShowS -> State LRState ShowS
latexTxt :: TextDetails -> State LRState ShowS -> State LRState ShowS
latexTxt td :: TextDetails
td cont :: State LRState ShowS
cont = let s1 :: String
s1 = TextDetails -> String
showTextDetails TextDetails
td in case String
s1 of
"" -> State LRState ShowS
cont
"\n" -> do
ShowS
annoBrace <- State LRState ShowS
endOfLine
ShowS
indent <- State LRState ShowS
getIndent
ShowS
s <- State LRState ShowS
cont
ShowS -> State LRState ShowS
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> State LRState ShowS) -> ShowS -> State LRState ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
annoBrace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString "\\\\\n" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
indent ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s
_ | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s1 -> do
ShowS
s2 <- State LRState ShowS
cont
ShowS -> State LRState ShowS
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> State LRState ShowS) -> ShowS -> State LRState ShowS
forall a b. (a -> b) -> a -> b
$ Char -> ShowS
showChar ' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2
| String
s1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
startTab -> do
ShowS
indent <- State LRState ShowS
addTabStop
ShowS
s2 <- State LRState ShowS
cont
ShowS -> State LRState ShowS
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> State LRState ShowS) -> ShowS -> State LRState ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
indent ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2
| String
s1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
endTab -> do
State LRState ()
subTabStop
State LRState ShowS
cont
| String
s1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
setTab -> do
LRState
s <- State LRState LRState
forall s. State s s
get
State LRState ()
setTabStop
ShowS
s2 <- State LRState ShowS
cont
let (eAn :: ShowS
eAn, sAn :: ShowS
sAn) = if LRState -> Bool
insideAnno LRState
s
then (Char -> ShowS
showChar '}', String -> ShowS
showString String
startAnno)
else (ShowS
forall a. a -> a
id, ShowS
forall a. a -> a
id)
ShowS -> State LRState ShowS
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> State LRState ShowS) -> ShowS -> State LRState ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
eAn
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (if LRState -> Int
indentTabsWritten LRState
s
Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LRState -> Int
setTabsThisLine LRState
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxTabs
Bool -> Bool -> Bool
|| LRState -> Bool
onlyTabs LRState
s then ShowS
forall a. a -> a
id else String -> ShowS
showString String
s1)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sAn ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2
| String
setTabWSp
String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`
String
s1 -> do
String -> State LRState ()
addTabWithSpaces String
s1
State LRState ShowS
cont
| String
s1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
startAnno -> do
Bool -> State LRState ()
setInsideAnno Bool
True
ShowS
s2 <- State LRState ShowS
cont
ShowS -> State LRState ShowS
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> State LRState ShowS) -> ShowS -> State LRState ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
s1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2
| String
s1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
endAnno -> do
Bool -> State LRState ()
setInsideAnno Bool
False
ShowS
s2 <- State LRState ShowS
cont
ShowS -> State LRState ShowS
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> State LRState ShowS) -> ShowS -> State LRState ShowS
forall a b. (a -> b) -> a -> b
$ Char -> ShowS
showChar '}' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2
| "\\kill\n"
String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf`
String
s1 -> do
ShowS
indent <- State LRState ShowS
getIndent
ShowS
s2 <- State LRState ShowS
cont
ShowS -> State LRState ShowS
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> State LRState ShowS) -> ShowS -> State LRState ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
s1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
indent ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2
_ -> do
Bool -> State LRState ()
setOnlyTabs Bool
False
ShowS
s2 <- State LRState ShowS
cont
ShowS -> State LRState ShowS
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> State LRState ShowS) -> ShowS -> State LRState ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
s1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
s2
setOnlyTabs :: Bool -> State LRState ()
setOnlyTabs :: Bool -> State LRState ()
setOnlyTabs b :: Bool
b = (LRState -> LRState) -> State LRState ()
forall s. (s -> s) -> State s ()
modify ((LRState -> LRState) -> State LRState ())
-> (LRState -> LRState) -> State LRState ()
forall a b. (a -> b) -> a -> b
$ \ s :: LRState
s -> LRState
s { onlyTabs :: Bool
onlyTabs = Bool
b }
setInsideAnno :: Bool -> State LRState ()
setInsideAnno :: Bool -> State LRState ()
setInsideAnno b :: Bool
b = (LRState -> LRState) -> State LRState ()
forall s. (s -> s) -> State s ()
modify ((LRState -> LRState) -> State LRState ())
-> (LRState -> LRState) -> State LRState ()
forall a b. (a -> b) -> a -> b
$ \ s :: LRState
s -> LRState
s { insideAnno :: Bool
insideAnno = Bool
b }
getIndent :: State LRState ShowS
getIndent :: State LRState ShowS
getIndent = do
LRState
s <- State LRState LRState
forall s. State s s
get
let indentTabsSum :: Int
indentTabsSum = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int -> Int
forall a. Enum a => a -> a
succ Int
maxTabs) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ LRState -> [Int]
indentTabs LRState
s
collSpcInds :: [Int]
collSpcInds = LRState -> [Int]
collSpaceIndents LRState
s
LRState -> State LRState ()
forall s. s -> State s ()
put (LRState -> State LRState ()) -> LRState -> State LRState ()
forall a b. (a -> b) -> a -> b
$ LRState
s
{ indentTabsWritten :: Int
indentTabsWritten = Int
indentTabsSum
, collSpaceIndents :: [Int]
collSpaceIndents = []
, onlyTabs :: Bool
onlyTabs = Bool
True
, totalTabStops :: Int
totalTabStops = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (LRState -> Int
totalTabStops LRState
s)
(Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
indentTabsSum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
collSpcInds }
let indent_fun :: ShowS
indent_fun = Int -> ShowS
tabIndent Int
indentTabsSum
space_format :: (String -> c) -> Int -> String -> c
space_format sf1 :: String -> c
sf1 i :: Int
i = String -> c
sf1 (String -> c) -> ShowS -> String -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i '~')
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString "\\="
new_tab_line :: ShowS
new_tab_line = (ShowS -> Int -> ShowS) -> ShowS -> [Int] -> ShowS
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ShowS -> Int -> ShowS
forall c. (String -> c) -> Int -> String -> c
space_format ShowS
forall a. a -> a
id (LRState -> [Int]
collSpaceIndents LRState
s)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString "\\kill\n"
sAnno :: ShowS
sAnno = if LRState -> Bool
insideAnno LRState
s then String -> ShowS
showString String
startAnno else ShowS
forall a. a -> a
id
ShowS -> State LRState ShowS
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> State LRState ShowS) -> ShowS -> State LRState ShowS
forall a b. (a -> b) -> a -> b
$ (if [Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
collSpcInds then ShowS
indent_fun else
ShowS
indent_fun ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
new_tab_line ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
indent_fun) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sAnno
tabIndent :: Int -> ShowS
tabIndent :: Int -> ShowS
tabIndent n :: Int
n = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id ([ShowS] -> ShowS) -> [ShowS] -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS -> [ShowS]
forall a. Int -> a -> [a]
replicate Int
n (ShowS -> [ShowS]) -> ShowS -> [ShowS]
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString "\\>"
endOfLine :: State LRState ShowS
endOfLine :: State LRState ShowS
endOfLine = do
LRState
s <- State LRState LRState
forall s. State s s
get
LRState -> State LRState ()
forall s. s -> State s ()
put LRState
s
{ isSetLine :: Bool
isSetLine = Bool
False
, setTabsThisLine :: Int
setTabsThisLine = 0 }
ShowS -> State LRState ShowS
forall (m :: * -> *) a. Monad m => a -> m a
return (ShowS -> State LRState ShowS) -> ShowS -> State LRState ShowS
forall a b. (a -> b) -> a -> b
$ if LRState -> Bool
insideAnno LRState
s then Char -> ShowS
showChar '}' else ShowS
forall a. a -> a
id
setTabStop :: State LRState ()
setTabStop :: State LRState ()
setTabStop = (LRState -> LRState) -> State LRState ()
forall s. (s -> s) -> State s ()
modify ((LRState -> LRState) -> State LRState ())
-> (LRState -> LRState) -> State LRState ()
forall a b. (a -> b) -> a -> b
$ \ s :: LRState
s ->
let new_setTabsThisLine :: Int
new_setTabsThisLine = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ LRState -> Int
setTabsThisLine LRState
s
in if LRState -> Bool
onlyTabs LRState
s then LRState
s { isSetLine :: Bool
isSetLine = Bool
True } else LRState
s
{ recentlySet :: Int
recentlySet = Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ LRState -> Int
recentlySet LRState
s
, setTabsThisLine :: Int
setTabsThisLine = Int
new_setTabsThisLine
, totalTabStops :: Int
totalTabStops = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (LRState -> Int
totalTabStops LRState
s)
(Int
new_setTabsThisLine Int -> Int -> Int
forall a. Num a => a -> a -> a
+ LRState -> Int
indentTabsWritten LRState
s)
, isSetLine :: Bool
isSetLine = Bool
True }
addTabWithSpaces :: String -> State LRState ()
addTabWithSpaces :: String -> State LRState ()
addTabWithSpaces str :: String
str = let
delay :: Int
delay :: Int
delay = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ShowS -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Char -> Bool
isDigit ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
tail (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
str
in (LRState -> LRState) -> State LRState ()
forall s. (s -> s) -> State s ()
modify ((LRState -> LRState) -> State LRState ())
-> (LRState -> LRState) -> State LRState ()
forall a b. (a -> b) -> a -> b
$ \ s :: LRState
s ->
LRState
s { collSpaceIndents :: [Int]
collSpaceIndents = LRState -> [Int]
collSpaceIndents LRState
s [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
delay] }
addTabStop :: State LRState ShowS
addTabStop :: State LRState ShowS
addTabStop = (LRState -> (ShowS, LRState)) -> State LRState ShowS
forall s a. (s -> (a, s)) -> State s a
state ((LRState -> (ShowS, LRState)) -> State LRState ShowS)
-> (LRState -> (ShowS, LRState)) -> State LRState ShowS
forall a b. (a -> b) -> a -> b
$ \ s :: LRState
s ->
let lineSet :: Bool
lineSet = LRState -> Bool
isSetLine LRState
s
recent :: Int
recent = LRState -> Int
recentlySet LRState
s
newTabs :: Int
newTabs = if Bool
lineSet then Int
recent else 1
new_indentTabs :: [Int]
new_indentTabs =
let iTabs :: [Int]
iTabs = LRState -> [Int]
indentTabs LRState
s
in if Int
newTabs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
iTabs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> LRState -> Int
totalTabStops LRState
s
then [Int]
iTabs
else [Int]
iTabs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
newTabs]
new_recentlySet :: Int
new_recentlySet =
if Bool
lineSet
then 0
else Int
recent
inTabs :: ShowS
inTabs = Int -> ShowS
tabIndent Int
newTabs
(indent_fun :: ShowS
indent_fun, new_indentTabsWritten :: Int
new_indentTabsWritten) =
let writtenTabs :: Int
writtenTabs = LRState -> Int
indentTabsWritten LRState
s
in if [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
new_indentTabs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
writtenTabs
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
lineSet Bool -> Bool -> Bool
&& LRState -> Bool
onlyTabs LRState
s
then (ShowS
inTabs, Int
newTabs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
writtenTabs)
else (ShowS
forall a. a -> a
id, Int
writtenTabs)
in (ShowS
indent_fun, LRState
s
{ recentlySet :: Int
recentlySet = Int
new_recentlySet
, indentTabs :: [Int]
indentTabs = [Int]
new_indentTabs
, indentTabsWritten :: Int
indentTabsWritten = Int
new_indentTabsWritten })
subTabStop :: State LRState ()
subTabStop :: State LRState ()
subTabStop = (LRState -> LRState) -> State LRState ()
forall s. (s -> s) -> State s ()
modify ((LRState -> LRState) -> State LRState ())
-> (LRState -> LRState) -> State LRState ()
forall a b. (a -> b) -> a -> b
$ \ s :: LRState
s -> LRState
s
{ indentTabs :: [Int]
indentTabs = case LRState -> [Int]
indentTabs LRState
s of
[] -> []
itabs :: [Int]
itabs -> [Int] -> [Int]
forall a. [a] -> [a]
init [Int]
itabs }
renderLatexCore :: Style -> Doc -> ShowS
renderLatexCore :: Style -> Doc -> ShowS
renderLatexCore latexStyle' :: Style
latexStyle' d :: Doc
d =
State LRState ShowS -> LRState -> ShowS
forall s a. State s a -> s -> a
evalState (Mode
-> Int
-> Float
-> (TextDetails -> State LRState ShowS -> State LRState ShowS)
-> State LRState ShowS
-> Doc
-> State LRState ShowS
forall a.
Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
fullRender
(Style -> Mode
mode Style
latexStyle')
(Style -> Int
lineLength Style
latexStyle')
(Style -> Float
ribbonsPerLine Style
latexStyle')
TextDetails -> State LRState ShowS -> State LRState ShowS
latexTxt (ShowS -> State LRState ShowS
forall (m :: * -> *) a. Monad m => a -> m a
return ShowS
forall a. a -> a
id) Doc
d) LRState
initialLRState
renderLatex :: Maybe Int -> Doc -> String
renderLatex :: Maybe Int -> Doc -> String
renderLatex mi :: Maybe Int
mi d :: Doc
d = String -> ShowS
showString "\\begin{hetcasl}\n"
ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Style -> Doc -> ShowS
renderLatexCore Style
latexStyle' Doc
d "\n\\end{hetcasl}\n"
where latexStyle' :: Style
latexStyle' = Style
latexStyle
{ lineLength :: Int
lineLength = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Style -> Int
lineLength Style
latexStyle) Maybe Int
mi }