{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TemplateHaskell #-}
module Diagrams.Backend.PGF.Surface
(
Surface(..)
, TexFormat(..)
, surfOnlineTex
, surfOnlineTexIO
, latexSurface
, contextSurface
, plaintexSurface
, sampleSurfaceOutput
, texFormat
, command
, arguments
, pageSize
, preamble
, beginDoc
, endDoc
) where
import Data.ByteString.Builder
import Data.Hashable (Hashable (..))
import Data.Typeable (Typeable)
import System.IO.Unsafe
import System.Texrunner.Online
import Diagrams.Prelude
import Prelude
data TexFormat = LaTeX | ConTeXt | PlainTeX
deriving (Int -> TexFormat -> ShowS
[TexFormat] -> ShowS
TexFormat -> String
(Int -> TexFormat -> ShowS)
-> (TexFormat -> String)
-> ([TexFormat] -> ShowS)
-> Show TexFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TexFormat] -> ShowS
$cshowList :: [TexFormat] -> ShowS
show :: TexFormat -> String
$cshow :: TexFormat -> String
showsPrec :: Int -> TexFormat -> ShowS
$cshowsPrec :: Int -> TexFormat -> ShowS
Show, ReadPrec [TexFormat]
ReadPrec TexFormat
Int -> ReadS TexFormat
ReadS [TexFormat]
(Int -> ReadS TexFormat)
-> ReadS [TexFormat]
-> ReadPrec TexFormat
-> ReadPrec [TexFormat]
-> Read TexFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TexFormat]
$creadListPrec :: ReadPrec [TexFormat]
readPrec :: ReadPrec TexFormat
$creadPrec :: ReadPrec TexFormat
readList :: ReadS [TexFormat]
$creadList :: ReadS [TexFormat]
readsPrec :: Int -> ReadS TexFormat
$creadsPrec :: Int -> ReadS TexFormat
Read, TexFormat -> TexFormat -> Bool
(TexFormat -> TexFormat -> Bool)
-> (TexFormat -> TexFormat -> Bool) -> Eq TexFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TexFormat -> TexFormat -> Bool
$c/= :: TexFormat -> TexFormat -> Bool
== :: TexFormat -> TexFormat -> Bool
$c== :: TexFormat -> TexFormat -> Bool
Eq, Typeable)
data Surface = Surface
{ Surface -> TexFormat
_texFormat :: TexFormat
, Surface -> String
_command :: String
, Surface -> [String]
_arguments :: [String]
, Surface -> Maybe (V2 Int -> String)
_pageSize :: Maybe (V2 Int -> String)
, Surface -> String
_preamble :: String
, Surface -> String
_beginDoc :: String
, Surface -> String
_endDoc :: String
}
makeLensesWith (lensRules & generateSignatures .~ False) ''Surface
texFormat :: Lens' Surface TexFormat
command :: Lens' Surface String
arguments :: Lens' Surface [String]
preamble :: Lens' Surface String
pageSize :: Lens' Surface (Maybe (V2 Int -> String))
beginDoc :: Lens' Surface String
endDoc :: Lens' Surface String
latexSurface :: Surface
latexSurface :: Surface
latexSurface = Surface :: TexFormat
-> String
-> [String]
-> Maybe (V2 Int -> String)
-> String
-> String
-> String
-> Surface
Surface
{ _texFormat :: TexFormat
_texFormat = TexFormat
LaTeX
, _command :: String
_command = String
"pdflatex"
, _arguments :: [String]
_arguments = []
, _pageSize :: Maybe (V2 Int -> String)
_pageSize = (V2 Int -> String) -> Maybe (V2 Int -> String)
forall a. a -> Maybe a
Just ((V2 Int -> String) -> Maybe (V2 Int -> String))
-> (V2 Int -> String) -> Maybe (V2 Int -> String)
forall a b. (a -> b) -> a -> b
$ \(V2 Int
w Int
h) ->
String
"\\pdfpagewidth=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\pdfpageheight=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\textheight=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\pdfhorigin=-76.6bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\pdfvorigin=-52.8bp"
, _preamble :: String
_preamble = String
"\\documentclass{article}\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\usepackage{pgfcore}\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\pagenumbering{gobble}"
, _beginDoc :: String
_beginDoc = String
"\\begin{document}"
, _endDoc :: String
_endDoc = String
"\\end{document}"
}
contextSurface :: Surface
contextSurface :: Surface
contextSurface = Surface :: TexFormat
-> String
-> [String]
-> Maybe (V2 Int -> String)
-> String
-> String
-> String
-> Surface
Surface
{ _texFormat :: TexFormat
_texFormat = TexFormat
ConTeXt
, _command :: String
_command = String
"context"
, _arguments :: [String]
_arguments = [String
"--pipe", String
"--once"]
, _pageSize :: Maybe (V2 Int -> String)
_pageSize = (V2 Int -> String) -> Maybe (V2 Int -> String)
forall a. a -> Maybe a
Just ((V2 Int -> String) -> Maybe (V2 Int -> String))
-> (V2 Int -> String) -> Maybe (V2 Int -> String)
forall a b. (a -> b) -> a -> b
$ \(V2 Int
w Int
h) ->
String
"\\definepapersize[diagram][width="String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"bp,height="String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h String -> ShowS
forall a. [a] -> [a] -> [a]
++String
"bp]\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\setuppapersize[diagram][diagram]\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\setuplayout\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" [ topspace=0bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" , backspace=0bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" , header=0bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" , footer=0bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" , width=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" , height=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ]"
, _preamble :: String
_preamble = String
"\\usemodule[pgf]\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\setuppagenumbering[location=]"
, _beginDoc :: String
_beginDoc = String
"\\starttext"
, _endDoc :: String
_endDoc = String
"\\stoptext"
}
plaintexSurface :: Surface
plaintexSurface :: Surface
plaintexSurface = Surface :: TexFormat
-> String
-> [String]
-> Maybe (V2 Int -> String)
-> String
-> String
-> String
-> Surface
Surface
{ _texFormat :: TexFormat
_texFormat = TexFormat
PlainTeX
, _command :: String
_command = String
"pdftex"
, _arguments :: [String]
_arguments = []
, _pageSize :: Maybe (V2 Int -> String)
_pageSize = (V2 Int -> String) -> Maybe (V2 Int -> String)
forall a. a -> Maybe a
Just ((V2 Int -> String) -> Maybe (V2 Int -> String))
-> (V2 Int -> String) -> Maybe (V2 Int -> String)
forall a b. (a -> b) -> a -> b
$ \(V2 Int
w Int
h) ->
String
"\\pdfpagewidth=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
w String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\pdfpageheight=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
h String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\pdfhorigin=-20bp\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\pdfvorigin=0bp"
, _preamble :: String
_preamble = String
"\\input eplain\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\beginpackages\n\\usepackage{color}\n\\endpackages\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\input pgfcore\n"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\def\\frac#1#2{{\\begingroup #1\\endgroup\\over #2}}"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\\nopagenumbers"
, _beginDoc :: String
_beginDoc = String
""
, _endDoc :: String
_endDoc = String
"\\bye"
}
instance Default Surface where
def :: Surface
def = Surface
latexSurface
sampleSurfaceOutput :: Surface -> String
sampleSurfaceOutput :: Surface -> String
sampleSurfaceOutput Surface
surf = [String] -> String
unlines
[ String
"command: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Surface
surf Surface -> Getting String Surface String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Surface String
Lens' Surface String
command String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords (Surface
surf Surface -> Getting [String] Surface [String] -> [String]
forall s a. s -> Getting a s a -> a
^. Getting [String] Surface [String]
Lens' Surface [String]
arguments)
, String
"\n% preamble"
, Surface
surf Surface -> Getting String Surface String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Surface String
Lens' Surface String
preamble
, String
"\n% pageSize"
, Getting String (Maybe String) String -> Maybe String -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String (Maybe String) String
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Surface
surf Surface
-> Getting
(Maybe (V2 Int -> String)) Surface (Maybe (V2 Int -> String))
-> Maybe (V2 Int -> String)
forall s a. s -> Getting a s a -> a
^. Getting
(Maybe (V2 Int -> String)) Surface (Maybe (V2 Int -> String))
Lens' Surface (Maybe (V2 Int -> String))
pageSize Maybe (V2 Int -> String) -> Maybe (V2 Int) -> Maybe String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> V2 Int -> Maybe (V2 Int)
forall a. a -> Maybe a
Just (Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 Int
100 Int
80)
, String
"\n% beginDoc"
, Surface
surf Surface -> Getting String Surface String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Surface String
Lens' Surface String
beginDoc
, String
"\n<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ TexFormat -> String
forall a. Show a => a -> String
show (Surface
surf Surface -> Getting TexFormat Surface TexFormat -> TexFormat
forall s a. s -> Getting a s a -> a
^. Getting TexFormat Surface TexFormat
Lens' Surface TexFormat
texFormat) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" pgf code>"
, String
"\n% endDoc"
, Surface
surf Surface -> Getting String Surface String -> String
forall s a. s -> Getting a s a -> a
^. Getting String Surface String
Lens' Surface String
endDoc
]
surfOnlineTex :: Surface -> OnlineTex a -> a
surfOnlineTex :: Surface -> OnlineTex a -> a
surfOnlineTex Surface
surf OnlineTex a
a = IO a -> a
forall a. IO a -> a
unsafePerformIO (Surface -> OnlineTex a -> IO a
forall a. Surface -> OnlineTex a -> IO a
surfOnlineTexIO Surface
surf OnlineTex a
a)
{-# NOINLINE surfOnlineTex #-}
surfOnlineTexIO :: Surface -> OnlineTex a -> IO a
surfOnlineTexIO :: Surface -> OnlineTex a -> IO a
surfOnlineTexIO Surface
surf = String -> [String] -> ByteString -> OnlineTex a -> IO a
forall a. String -> [String] -> ByteString -> OnlineTex a -> IO a
runOnlineTex (Surface
surfSurface -> Getting String Surface String -> String
forall s a. s -> Getting a s a -> a
^.Getting String Surface String
Lens' Surface String
command) (Surface
surfSurface -> Getting [String] Surface [String] -> [String]
forall s a. s -> Getting a s a -> a
^.Getting [String] Surface [String]
Lens' Surface [String]
arguments) ByteString
begin
where
begin :: ByteString
begin = Getting ByteString ByteString ByteString
-> ByteString -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString ByteString ByteString
forall lazy strict. Strict lazy strict => Iso' lazy strict
strict (ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (String -> Builder) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Builder
stringUtf8
(String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Surface
surf Surface -> Getting String Surface String -> String
forall s a. s -> Getting a s a -> a
^. (Getting String Surface String
Lens' Surface String
preamble Getting String Surface String
-> Getting String Surface String -> Getting String Surface String
forall a. Semigroup a => a -> a -> a
<> Getting String Surface String
Lens' Surface String
beginDoc)
instance Hashable TexFormat where
hashWithSalt :: Int -> TexFormat -> Int
hashWithSalt Int
s TexFormat
LaTeX = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
1::Int)
hashWithSalt Int
s TexFormat
ConTeXt = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
2::Int)
hashWithSalt Int
s TexFormat
PlainTeX = Int
s Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` (Int
3::Int)
instance Eq Surface where
Surface TexFormat
tf1 String
cm1 [String]
ar1 Maybe (V2 Int -> String)
ps1 String
p1 String
bd1 String
ed1 == :: Surface -> Surface -> Bool
== Surface TexFormat
tf2 String
cm2 [String]
ar2 Maybe (V2 Int -> String)
ps2 String
p2 String
bd2 String
ed2
= [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
[ TexFormat
tf1 TexFormat -> TexFormat -> Bool
forall a. Eq a => a -> a -> Bool
== TexFormat
tf2
, String
cm1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
cm2
, [String]
ar1 [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
ar2
, (Maybe (V2 Int -> String)
ps1 Maybe (V2 Int -> String) -> Maybe (V2 Int) -> Maybe String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> V2 Int -> Maybe (V2 Int)
forall a. a -> Maybe a
Just (Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 Int
1 Int
2)) Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe (V2 Int -> String)
ps2 Maybe (V2 Int -> String) -> Maybe (V2 Int) -> Maybe String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> V2 Int -> Maybe (V2 Int)
forall a. a -> Maybe a
Just (Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 Int
1 Int
2))
, String
p1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
p2
, String
bd1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
bd2
, String
ed1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
ed2
]
instance Hashable Surface where
hashWithSalt :: Int -> Surface -> Int
hashWithSalt Int
s (Surface TexFormat
tf String
cm [String]
ar Maybe (V2 Int -> String)
ps String
p String
bd String
ed)
= Int
s Int -> TexFormat -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
TexFormat
tf Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
String
cm Int -> [String] -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
[String]
ar Int -> Maybe String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
Maybe (V2 Int -> String)
ps Maybe (V2 Int -> String) -> Maybe (V2 Int) -> Maybe String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> V2 Int -> Maybe (V2 Int)
forall a. a -> Maybe a
Just (Int -> Int -> V2 Int
forall a. a -> a -> V2 a
V2 Int
1 Int
2) Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
String
p Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
String
bd Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt`
String
ed