{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, FlexibleContexts, ExtendedDefaultRules, ExistentialQuantification, CPP #-}
-- |
-- Internal representations of the Matplotlib data. These are not API-stable
-- and may change. You can easily extend the provided bindings without relying
-- on the internals exposed here but they are provided just in case.
module Graphics.Matplotlib.Internal where
import System.IO.Temp
import System.Process
import Data.Aeson
import Control.Monad
import Control.DeepSeq
import System.IO
import qualified Data.ByteString.Lazy as B
import Data.List
import Control.Exception
import qualified Data.Sequence as S
import Data.Sequence (Seq, (|>), (><))
import Data.Maybe
import Data.Monoid
import GHC.Exts(toList)

-- | A handy miscellaneous function to linearly map over a range of numbers in a given number of steps
mapLinear :: (Double -> b) -> Double -> Double -> Double -> [b]
mapLinear :: (Double -> b) -> Double -> Double -> Double -> [b]
mapLinear Double -> b
f Double
s Double
e Double
n = (Double -> b) -> [Double] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (\Double
v -> Double -> b
f (Double -> b) -> Double -> b
forall a b. (a -> b) -> a -> b
$ Double
s Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
v Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
e Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
s) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
n)) [Double
0..Double
n]

-- $ Basics

-- | The wrapper type for a matplotlib computation.
data Matplotlib = Matplotlib {
  Matplotlib -> Seq MplotCommand
mpCommands :: Seq MplotCommand   -- ^ Resolved computations that have been transformed to commands
  , Matplotlib -> Maybe ([Option] -> MplotCommand)
mpPendingOption :: Maybe ([Option] -> MplotCommand)   -- ^ A pending computation that is affected by applied options
  , Matplotlib -> Seq MplotCommand
mpRest :: Seq MplotCommand  -- ^ Computations that follow the one that is pending
  }

-- | Monoid instance for Matplotlib type
instance Monoid Matplotlib where
    mempty :: Matplotlib
mempty  = Matplotlib
mp
#if !MIN_VERSION_base(4,11,0)
    mappend = (%)
#else
instance Semigroup Matplotlib where
    <> :: Matplotlib -> Matplotlib -> Matplotlib
(<>) = Matplotlib -> Matplotlib -> Matplotlib
(%)
#endif

instance NFData Matplotlib where
    rnf :: Matplotlib -> ()
rnf (Matplotlib Seq MplotCommand
cs Maybe ([Option] -> MplotCommand)
po Seq MplotCommand
re) = Seq MplotCommand -> ()
forall a. NFData a => a -> ()
rnf Seq MplotCommand
cs () -> () -> ()
`seq` Maybe ([Option] -> MplotCommand) -> ()
forall a. NFData a => a -> ()
rnf Maybe ([Option] -> MplotCommand)
po () -> () -> ()
`seq` Seq MplotCommand -> ()
forall a. NFData a => a -> ()
rnf Seq MplotCommand
re

-- | A maplotlib command, right now we have a very shallow embedding essentially
-- dealing in strings containing python code as well as the ability to load
-- data. The loaded data should be a json object.
data MplotCommand =
  LoadData B.ByteString
  | forall x. MplotImage x => LoadImage x
  | Exec { MplotCommand -> String
es :: String }

instance NFData MplotCommand where
    rnf :: MplotCommand -> ()
rnf (LoadData ByteString
b) = ByteString -> ()
forall a. NFData a => a -> ()
rnf ByteString
b
    rnf (Exec String
es)    = String -> ()
forall a. NFData a => a -> ()
rnf String
es
    -- don't care too much about the LoadImage

-- | Throughout the API we need to accept options in order to expose
-- matplotlib's many configuration options.
data Option =
  -- | results in a=b
  K String String
  -- | just inserts the option verbatim as an argument at the end of the function
  | P String
  deriving (Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Option] -> ShowS
$cshowList :: [Option] -> ShowS
show :: Option -> String
$cshow :: Option -> String
showsPrec :: Int -> Option -> ShowS
$cshowsPrec :: Int -> Option -> ShowS
Show, Option -> Option -> Bool
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c== :: Option -> Option -> Bool
Eq, Eq Option
Eq Option
-> (Option -> Option -> Ordering)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Bool)
-> (Option -> Option -> Option)
-> (Option -> Option -> Option)
-> Ord Option
Option -> Option -> Bool
Option -> Option -> Ordering
Option -> Option -> Option
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Option -> Option -> Option
$cmin :: Option -> Option -> Option
max :: Option -> Option -> Option
$cmax :: Option -> Option -> Option
>= :: Option -> Option -> Bool
$c>= :: Option -> Option -> Bool
> :: Option -> Option -> Bool
$c> :: Option -> Option -> Bool
<= :: Option -> Option -> Bool
$c<= :: Option -> Option -> Bool
< :: Option -> Option -> Bool
$c< :: Option -> Option -> Bool
compare :: Option -> Option -> Ordering
$ccompare :: Option -> Option -> Ordering
$cp1Ord :: Eq Option
Ord)

-- | Convert an 'MplotCommand' to python code, doesn't do much right now
toPy :: MplotCommand -> String
toPy :: MplotCommand -> String
toPy (LoadData ByteString
_) = ShowS
forall a. HasCallStack => String -> a
error String
"withMplot needed to load data"
toPy (LoadImage x
_) = ShowS
forall a. HasCallStack => String -> a
error String
"withMplot needed to load images"
toPy (Exec String
str)   = String
str

-- | Resolve the pending command with no options provided.
resolvePending :: Matplotlib -> Matplotlib
resolvePending :: Matplotlib -> Matplotlib
resolvePending Matplotlib
m = Matplotlib
m { mpCommands :: Seq MplotCommand
mpCommands =
                       (Seq MplotCommand
-> (([Option] -> MplotCommand) -> Seq MplotCommand)
-> Maybe ([Option] -> MplotCommand)
-> Seq MplotCommand
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Matplotlib -> Seq MplotCommand
mpCommands Matplotlib
m)
                              (\[Option] -> MplotCommand
pendingCommand -> (Matplotlib -> Seq MplotCommand
mpCommands Matplotlib
m Seq MplotCommand -> MplotCommand -> Seq MplotCommand
forall a. Seq a -> a -> Seq a
|> [Option] -> MplotCommand
pendingCommand []))
                              (Maybe ([Option] -> MplotCommand) -> Seq MplotCommand)
-> Maybe ([Option] -> MplotCommand) -> Seq MplotCommand
forall a b. (a -> b) -> a -> b
$ Matplotlib -> Maybe ([Option] -> MplotCommand)
mpPendingOption Matplotlib
m) Seq MplotCommand -> Seq MplotCommand -> Seq MplotCommand
forall a. Seq a -> Seq a -> Seq a
>< Matplotlib -> Seq MplotCommand
mpRest Matplotlib
m
                     , mpPendingOption :: Maybe ([Option] -> MplotCommand)
mpPendingOption = Maybe ([Option] -> MplotCommand)
forall a. Maybe a
Nothing
                     , mpRest :: Seq MplotCommand
mpRest = Seq MplotCommand
forall a. Seq a
S.empty}

-- | The io action is given a list of python commands to execute (note that
-- these are commands in the sense of lines of python code; each inidivudal line
-- may not be parseable on its own)
withMplot :: Matplotlib -> ([String] -> IO a) -> IO a
withMplot :: Matplotlib -> ([String] -> IO a) -> IO a
withMplot Matplotlib
m [String] -> IO a
f = [MplotCommand] -> [MplotCommand] -> IO a
preload [MplotCommand]
cs []
  where
    cs :: [Item (Seq MplotCommand)]
cs = Seq MplotCommand -> [Item (Seq MplotCommand)]
forall l. IsList l => l -> [Item l]
toList (Seq MplotCommand -> [Item (Seq MplotCommand)])
-> Seq MplotCommand -> [Item (Seq MplotCommand)]
forall a b. (a -> b) -> a -> b
$ Matplotlib -> Seq MplotCommand
mpCommands (Matplotlib -> Seq MplotCommand) -> Matplotlib -> Seq MplotCommand
forall a b. (a -> b) -> a -> b
$ Matplotlib -> Matplotlib
resolvePending Matplotlib
m
    preload :: [MplotCommand] -> [MplotCommand] -> IO a
preload [] [MplotCommand]
cmds = [String] -> IO a
f ([String] -> IO a) -> [String] -> IO a
forall a b. (a -> b) -> a -> b
$ (MplotCommand -> String) -> [MplotCommand] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map MplotCommand -> String
toPy ([MplotCommand] -> [String]) -> [MplotCommand] -> [String]
forall a b. (a -> b) -> a -> b
$ [MplotCommand] -> [MplotCommand]
forall a. [a] -> [a]
reverse [MplotCommand]
cmds
    preload ((LoadData ByteString
obj):[MplotCommand]
l) [MplotCommand]
cmds =
          String -> (String -> Handle -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"data.json"
            (\String
dataFile Handle
dataHandle -> do
                Handle -> ByteString -> IO ()
B.hPutStr Handle
dataHandle ByteString
obj
                Handle -> IO ()
hClose Handle
dataHandle
                [MplotCommand] -> [MplotCommand] -> IO a
preload [MplotCommand]
l ([MplotCommand] -> IO a) -> [MplotCommand] -> IO a
forall a b. (a -> b) -> a -> b
$ (((String -> MplotCommand) -> [String] -> [MplotCommand]
forall a b. (a -> b) -> [a] -> [b]
map String -> MplotCommand
Exec ([String] -> [MplotCommand]) -> [String] -> [MplotCommand]
forall a b. (a -> b) -> a -> b
$ String -> [String]
pyReadData String
dataFile) [MplotCommand] -> [MplotCommand] -> [MplotCommand]
forall a. [a] -> [a] -> [a]
++ [MplotCommand]
cmds))
    preload ((LoadImage x
img):[MplotCommand]
l) [MplotCommand]
cmds = do
      String -> (String -> Handle -> IO a) -> IO a
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"data.json" ((String -> Handle -> IO a) -> IO a)
-> (String -> Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$
        (\String
dataFile Handle
dataHandle -> do
            Handle -> IO ()
hClose Handle
dataHandle
            String
obj <- x -> String -> IO String
forall a. MplotImage a => a -> String -> IO String
saveHaskellImage x
img String
dataFile
            [MplotCommand] -> [MplotCommand] -> IO a
preload [MplotCommand]
l ([MplotCommand] -> IO a) -> [MplotCommand] -> IO a
forall a b. (a -> b) -> a -> b
$ ([String -> MplotCommand
Exec (String -> MplotCommand) -> String -> MplotCommand
forall a b. (a -> b) -> a -> b
$ String
"img = " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (x -> String -> ShowS
forall a. MplotImage a => a -> String -> ShowS
loadPythonImage x
img String
obj String
dataFile)] [MplotCommand] -> [MplotCommand] -> [MplotCommand]
forall a. [a] -> [a] -> [a]
++ [MplotCommand]
cmds))
    preload (MplotCommand
c:[MplotCommand]
l) [MplotCommand]
cmds = [MplotCommand] -> [MplotCommand] -> IO a
preload [MplotCommand]
l (MplotCommand
cMplotCommand -> [MplotCommand] -> [MplotCommand]
forall a. a -> [a] -> [a]
:[MplotCommand]
cmds)

-- | Create a plot that executes the string as python code
mplotString :: String -> Matplotlib
mplotString :: String -> Matplotlib
mplotString String
s = Seq MplotCommand
-> Maybe ([Option] -> MplotCommand)
-> Seq MplotCommand
-> Matplotlib
Matplotlib Seq MplotCommand
forall a. Seq a
S.empty Maybe ([Option] -> MplotCommand)
forall a. Maybe a
Nothing (MplotCommand -> Seq MplotCommand
forall a. a -> Seq a
S.singleton (MplotCommand -> Seq MplotCommand)
-> MplotCommand -> Seq MplotCommand
forall a b. (a -> b) -> a -> b
$ String -> MplotCommand
Exec String
s)

-- | Create an empty plot. This the beginning of most plotting commands.
mp :: Matplotlib
mp :: Matplotlib
mp = Seq MplotCommand
-> Maybe ([Option] -> MplotCommand)
-> Seq MplotCommand
-> Matplotlib
Matplotlib Seq MplotCommand
forall a. Seq a
S.empty Maybe ([Option] -> MplotCommand)
forall a. Maybe a
Nothing Seq MplotCommand
forall a. Seq a
S.empty

-- | Load the given data into the python "data" array
readData :: ToJSON a => a -> Matplotlib
readData :: a -> Matplotlib
readData a
d = Seq MplotCommand
-> Maybe ([Option] -> MplotCommand)
-> Seq MplotCommand
-> Matplotlib
Matplotlib (MplotCommand -> Seq MplotCommand
forall a. a -> Seq a
S.singleton (MplotCommand -> Seq MplotCommand)
-> MplotCommand -> Seq MplotCommand
forall a b. (a -> b) -> a -> b
$ ByteString -> MplotCommand
LoadData (ByteString -> MplotCommand) -> ByteString -> MplotCommand
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
d) Maybe ([Option] -> MplotCommand)
forall a. Maybe a
Nothing Seq MplotCommand
forall a. Seq a
S.empty

-- | Load the given image into python "img" variable
readImage :: MplotImage i => i -> Matplotlib
readImage :: i -> Matplotlib
readImage i
i = Seq MplotCommand
-> Maybe ([Option] -> MplotCommand)
-> Seq MplotCommand
-> Matplotlib
Matplotlib (MplotCommand -> Seq MplotCommand
forall a. a -> Seq a
S.singleton (MplotCommand -> Seq MplotCommand)
-> MplotCommand -> Seq MplotCommand
forall a b. (a -> b) -> a -> b
$ i -> MplotCommand
forall x. MplotImage x => x -> MplotCommand
LoadImage i
i) Maybe ([Option] -> MplotCommand)
forall a. Maybe a
Nothing Seq MplotCommand
forall a. Seq a
S.empty

infixl 5 %
-- | Combine two matplotlib commands
(%) :: Matplotlib -> Matplotlib -> Matplotlib
Matplotlib
a % :: Matplotlib -> Matplotlib -> Matplotlib
% Matplotlib
b | Maybe ([Option] -> MplotCommand) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ([Option] -> MplotCommand) -> Bool)
-> Maybe ([Option] -> MplotCommand) -> Bool
forall a b. (a -> b) -> a -> b
$ Matplotlib -> Maybe ([Option] -> MplotCommand)
mpPendingOption Matplotlib
b = Matplotlib
b { mpCommands :: Seq MplotCommand
mpCommands = Matplotlib -> Seq MplotCommand
mpCommands (Matplotlib -> Matplotlib
resolvePending Matplotlib
a) Seq MplotCommand -> Seq MplotCommand -> Seq MplotCommand
forall a. Seq a -> Seq a -> Seq a
>< Matplotlib -> Seq MplotCommand
mpCommands Matplotlib
b }
      | Bool
otherwise = Matplotlib
a { mpRest :: Seq MplotCommand
mpRest = Matplotlib -> Seq MplotCommand
mpRest Matplotlib
a Seq MplotCommand -> Seq MplotCommand -> Seq MplotCommand
forall a. Seq a -> Seq a -> Seq a
>< Matplotlib -> Seq MplotCommand
mpCommands Matplotlib
b Seq MplotCommand -> Seq MplotCommand -> Seq MplotCommand
forall a. Seq a -> Seq a -> Seq a
>< Matplotlib -> Seq MplotCommand
mpRest Matplotlib
b }

infixl 6 #
-- | Add Python code to the last matplotlib command
(#) :: (MplotValue val) => Matplotlib -> val -> Matplotlib
Matplotlib
m # :: Matplotlib -> val -> Matplotlib
# val
v | Seq MplotCommand -> Bool
forall a. Seq a -> Bool
S.null (Seq MplotCommand -> Bool) -> Seq MplotCommand -> Bool
forall a b. (a -> b) -> a -> b
$ Matplotlib -> Seq MplotCommand
mpRest Matplotlib
m =
        case Matplotlib -> Maybe ([Option] -> MplotCommand)
mpPendingOption Matplotlib
m of
          Maybe ([Option] -> MplotCommand)
Nothing -> Matplotlib
m { mpRest :: Seq MplotCommand
mpRest = MplotCommand -> Seq MplotCommand
forall a. a -> Seq a
S.singleton (MplotCommand -> Seq MplotCommand)
-> MplotCommand -> Seq MplotCommand
forall a b. (a -> b) -> a -> b
$ String -> MplotCommand
Exec (String -> MplotCommand) -> String -> MplotCommand
forall a b. (a -> b) -> a -> b
$ val -> String
forall val. MplotValue val => val -> String
toPython val
v }
          (Just [Option] -> MplotCommand
f) -> Matplotlib
m { mpPendingOption :: Maybe ([Option] -> MplotCommand)
mpPendingOption = ([Option] -> MplotCommand) -> Maybe ([Option] -> MplotCommand)
forall a. a -> Maybe a
Just (\[Option]
o -> String -> MplotCommand
Exec (String -> MplotCommand) -> String -> MplotCommand
forall a b. (a -> b) -> a -> b
$ MplotCommand -> String
es ([Option] -> MplotCommand
f [Option]
o) String -> ShowS
forall a. [a] -> [a] -> [a]
++ val -> String
forall val. MplotValue val => val -> String
toPython val
v)}
      | Bool
otherwise = Matplotlib
m { mpRest :: Seq MplotCommand
mpRest = (MplotCommand -> MplotCommand)
-> Int -> Seq MplotCommand -> Seq MplotCommand
forall a. (a -> a) -> Int -> Seq a -> Seq a
S.adjust (\(Exec String
s) -> String -> MplotCommand
Exec (String -> MplotCommand) -> String -> MplotCommand
forall a b. (a -> b) -> a -> b
$ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ val -> String
forall val. MplotValue val => val -> String
toPython val
v) (Seq MplotCommand -> Int
forall a. Seq a -> Int
S.length (Matplotlib -> Seq MplotCommand
mpRest Matplotlib
m) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Matplotlib -> Seq MplotCommand
mpRest Matplotlib
m) }

-- | A string to be rendered in python as a string. In other words it is
-- rendered as 'str'.
data S = S String
  deriving (Int -> S -> ShowS
[S] -> ShowS
S -> String
(Int -> S -> ShowS) -> (S -> String) -> ([S] -> ShowS) -> Show S
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S] -> ShowS
$cshowList :: [S] -> ShowS
show :: S -> String
$cshow :: S -> String
showsPrec :: Int -> S -> ShowS
$cshowsPrec :: Int -> S -> ShowS
Show, S -> S -> Bool
(S -> S -> Bool) -> (S -> S -> Bool) -> Eq S
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S -> S -> Bool
$c/= :: S -> S -> Bool
== :: S -> S -> Bool
$c== :: S -> S -> Bool
Eq, Eq S
Eq S
-> (S -> S -> Ordering)
-> (S -> S -> Bool)
-> (S -> S -> Bool)
-> (S -> S -> Bool)
-> (S -> S -> Bool)
-> (S -> S -> S)
-> (S -> S -> S)
-> Ord S
S -> S -> Bool
S -> S -> Ordering
S -> S -> S
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: S -> S -> S
$cmin :: S -> S -> S
max :: S -> S -> S
$cmax :: S -> S -> S
>= :: S -> S -> Bool
$c>= :: S -> S -> Bool
> :: S -> S -> Bool
$c> :: S -> S -> Bool
<= :: S -> S -> Bool
$c<= :: S -> S -> Bool
< :: S -> S -> Bool
$c< :: S -> S -> Bool
compare :: S -> S -> Ordering
$ccompare :: S -> S -> Ordering
$cp1Ord :: Eq S
Ord)

-- | A string to be rendered in python as a raw string. In other words it is
-- rendered as r'str'.
data R = R String
  deriving (Int -> R -> ShowS
[R] -> ShowS
R -> String
(Int -> R -> ShowS) -> (R -> String) -> ([R] -> ShowS) -> Show R
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [R] -> ShowS
$cshowList :: [R] -> ShowS
show :: R -> String
$cshow :: R -> String
showsPrec :: Int -> R -> ShowS
$cshowsPrec :: Int -> R -> ShowS
Show, R -> R -> Bool
(R -> R -> Bool) -> (R -> R -> Bool) -> Eq R
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: R -> R -> Bool
$c/= :: R -> R -> Bool
== :: R -> R -> Bool
$c== :: R -> R -> Bool
Eq, Eq R
Eq R
-> (R -> R -> Ordering)
-> (R -> R -> Bool)
-> (R -> R -> Bool)
-> (R -> R -> Bool)
-> (R -> R -> Bool)
-> (R -> R -> R)
-> (R -> R -> R)
-> Ord R
R -> R -> Bool
R -> R -> Ordering
R -> R -> R
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: R -> R -> R
$cmin :: R -> R -> R
max :: R -> R -> R
$cmax :: R -> R -> R
>= :: R -> R -> Bool
$c>= :: R -> R -> Bool
> :: R -> R -> Bool
$c> :: R -> R -> Bool
<= :: R -> R -> Bool
$c<= :: R -> R -> Bool
< :: R -> R -> Bool
$c< :: R -> R -> Bool
compare :: R -> R -> Ordering
$ccompare :: R -> R -> Ordering
$cp1Ord :: Eq R
Ord)

-- | A string to be rendered in python as a raw literal/code. In other words it is
-- inserted directly as is into the code.
data L = L String
  deriving (Int -> L -> ShowS
[L] -> ShowS
L -> String
(Int -> L -> ShowS) -> (L -> String) -> ([L] -> ShowS) -> Show L
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [L] -> ShowS
$cshowList :: [L] -> ShowS
show :: L -> String
$cshow :: L -> String
showsPrec :: Int -> L -> ShowS
$cshowsPrec :: Int -> L -> ShowS
Show, L -> L -> Bool
(L -> L -> Bool) -> (L -> L -> Bool) -> Eq L
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: L -> L -> Bool
$c/= :: L -> L -> Bool
== :: L -> L -> Bool
$c== :: L -> L -> Bool
Eq, Eq L
Eq L
-> (L -> L -> Ordering)
-> (L -> L -> Bool)
-> (L -> L -> Bool)
-> (L -> L -> Bool)
-> (L -> L -> Bool)
-> (L -> L -> L)
-> (L -> L -> L)
-> Ord L
L -> L -> Bool
L -> L -> Ordering
L -> L -> L
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: L -> L -> L
$cmin :: L -> L -> L
max :: L -> L -> L
$cmax :: L -> L -> L
>= :: L -> L -> Bool
$c>= :: L -> L -> Bool
> :: L -> L -> Bool
$c> :: L -> L -> Bool
<= :: L -> L -> Bool
$c<= :: L -> L -> Bool
< :: L -> L -> Bool
$c< :: L -> L -> Bool
compare :: L -> L -> Ordering
$ccompare :: L -> L -> Ordering
$cp1Ord :: Eq L
Ord)

-- | Values which can be combined together to form a matplotlib command. These
-- specify how values are rendered in Python code.
class MplotValue val where
  -- | Render a value inline in Python code
  toPython :: val -> String
  -- | Render a value as an optional parameter in Python code
  toPythonOpt :: val -> String
  toPythonOpt = val -> String
forall val. MplotValue val => val -> String
toPython

instance MplotValue S where
  toPython :: S -> String
toPython (S String
s) = String
"'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
instance MplotValue R where
  toPython :: R -> String
toPython (R String
s) = String
"r'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"
instance MplotValue L where
  toPython :: L -> String
toPython (L String
s) = String
s
instance MplotValue String where
  -- | A string is just a literal when used in code
  toPython :: ShowS
toPython String
s = String
s
  -- | A string is a real quoted python string when used as an option
  toPythonOpt :: ShowS
toPythonOpt String
s = S -> String
forall val. MplotValue val => val -> String
toPythonOpt (S -> String) -> S -> String
forall a b. (a -> b) -> a -> b
$ String -> S
S String
s
instance MplotValue [String] where
  toPython :: [String] -> String
toPython [] = String
""
  toPython (String
x:[String]
xs) = ShowS
forall val. MplotValue val => val -> String
toPython String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall val. MplotValue val => val -> String
toPython [String]
xs
  -- | A list of strings is a list of python strings, not literals
  toPythonOpt :: [String] -> String
toPythonOpt [String]
s = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
f [String]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    where f :: [String] -> String
f [] = String
""
          f (String
x:[String]
xs) = S -> String
forall val. MplotValue val => val -> String
toPythonOpt (String -> S
str String
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
f [String]
xs
instance MplotValue Double where
  toPython :: Double -> String
toPython Double
s = Double -> String
forall a. Show a => a -> String
show Double
s
instance MplotValue [Double] where
  toPython :: [Double] -> String
toPython [Double]
s = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Double] -> String
forall val. MplotValue val => [val] -> String
f [Double]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    where f :: [val] -> String
f [] = String
""
          f (val
x:[val]
xs) = val -> String
forall val. MplotValue val => val -> String
toPython val
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [val] -> String
f [val]
xs
instance MplotValue Integer where
  toPython :: Integer -> String
toPython Integer
s = Integer -> String
forall a. Show a => a -> String
show Integer
s
instance MplotValue [Integer] where
  toPython :: [Integer] -> String
toPython [Integer]
s = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Integer] -> String
forall val. MplotValue val => [val] -> String
f [Integer]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    where f :: [val] -> String
f [] = String
""
          f (val
x:[val]
xs) = val -> String
forall val. MplotValue val => val -> String
toPython val
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [val] -> String
f [val]
xs
instance MplotValue Int where
  toPython :: Int -> String
toPython Int
s = Int -> String
forall a. Show a => a -> String
show Int
s
instance MplotValue [Int] where
  toPython :: [Int] -> String
toPython [Int]
s = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall val. MplotValue val => [val] -> String
f [Int]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    where f :: [val] -> String
f [] = String
""
          f (val
x:[val]
xs) = val -> String
forall val. MplotValue val => val -> String
toPython val
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [val] -> String
f [val]
xs
instance MplotValue [R] where
  toPython :: [R] -> String
toPython [R]
s = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [R] -> String
forall val. MplotValue val => [val] -> String
f [R]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    where f :: [val] -> String
f [] = String
""
          f (val
x:[val]
xs) = val -> String
forall val. MplotValue val => val -> String
toPython val
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [val] -> String
f [val]
xs
instance MplotValue [S] where
  toPython :: [S] -> String
toPython [S]
s = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [S] -> String
forall val. MplotValue val => [val] -> String
f [S]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    where f :: [val] -> String
f [] = String
""
          f (val
x:[val]
xs) = val -> String
forall val. MplotValue val => val -> String
toPython val
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [val] -> String
f [val]
xs
instance MplotValue [L] where
  toPython :: [L] -> String
toPython [L]
s = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [L] -> String
forall val. MplotValue val => [val] -> String
f [L]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    where f :: [val] -> String
f [] = String
""
          f (val
x:[val]
xs) = val -> String
forall val. MplotValue val => val -> String
toPython val
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [val] -> String
f [val]
xs
instance MplotValue Bool where
  toPython :: Bool -> String
toPython Bool
s = Bool -> String
forall a. Show a => a -> String
show Bool
s
instance (MplotValue x) => MplotValue (x, x) where
  toPython :: (x, x) -> String
toPython (x
k, x
v) = String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++ x -> String
forall val. MplotValue val => val -> String
toPython x
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ x -> String
forall val. MplotValue val => val -> String
toPython x
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
instance (MplotValue (x, y)) => MplotValue [(x, y)] where
  toPython :: [(x, y)] -> String
toPython [(x, y)]
s = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(x, y)] -> String
forall val. MplotValue val => [val] -> String
f [(x, y)]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    where f :: [val] -> String
f [] = String
""
          f (val
x:[val]
xs) = val -> String
forall val. MplotValue val => val -> String
toPython val
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [val] -> String
f [val]
xs
instance MplotValue x => MplotValue (Maybe x) where
  toPython :: Maybe x -> String
toPython Maybe x
Nothing  = String
"None"
  toPython (Just x
x) = x -> String
forall val. MplotValue val => val -> String
toPython x
x
instance MplotValue [[Double]] where
  toPython :: [[Double]] -> String
toPython [[Double]]
s = String
"np.asarray([" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Double]] -> String
forall val. MplotValue val => [val] -> String
f [[Double]]
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"])"
    where f :: [val] -> String
f [] = String
""
          f (val
x:[val]
xs) = val -> String
forall val. MplotValue val => val -> String
toPython val
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ [val] -> String
f [val]
xs

default (Integer, Int, Double)

-- | The class of Haskell images or references to imagese which can be
-- transferred to matplotlib.
class MplotImage a where
  saveHaskellImage :: a -> FilePath -> IO String
  loadPythonImage :: a -> String -> FilePath -> String

-- | An image that is a string is a file path.
instance MplotImage String where
  saveHaskellImage :: String -> String -> IO String
saveHaskellImage String
_ String
_ = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
  loadPythonImage :: String -> String -> ShowS
loadPythonImage String
s String
_ String
_ = String
"mpimg.imread('" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall val. MplotValue val => val -> String
toPython String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"')"

instance ToJSON a => MplotImage [[a]] where
  saveHaskellImage :: [[a]] -> String -> IO String
saveHaskellImage [[a]]
d String
fp = (String -> ByteString -> IO ()
B.writeFile String
fp (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ [[a]] -> ByteString
forall a. ToJSON a => a -> ByteString
encode [[a]]
d) IO () -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
  loadPythonImage :: [[a]] -> String -> ShowS
loadPythonImage [[a]]
s String
_ String
fp = [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String]
pyReadData String
fp

-- $ Options

-- | Add an option to the last matplotlib command. Commands can have only one option!
-- optFn :: Matplotlib -> Matplotlib
optFn :: ([Option] -> String) -> Matplotlib -> Matplotlib
optFn :: ([Option] -> String) -> Matplotlib -> Matplotlib
optFn [Option] -> String
f Matplotlib
l | Maybe ([Option] -> MplotCommand) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ([Option] -> MplotCommand) -> Bool)
-> Maybe ([Option] -> MplotCommand) -> Bool
forall a b. (a -> b) -> a -> b
$ Matplotlib -> Maybe ([Option] -> MplotCommand)
mpPendingOption Matplotlib
l = String -> Matplotlib
forall a. HasCallStack => String -> a
error String
"Commands can have only open option. TODO Enforce this through the type system or relax it!"
          | Bool
otherwise = Matplotlib
l' { mpPendingOption :: Maybe ([Option] -> MplotCommand)
mpPendingOption = ([Option] -> MplotCommand) -> Maybe ([Option] -> MplotCommand)
forall a. a -> Maybe a
Just (\[Option]
os -> String -> MplotCommand
Exec (String
sl String -> ShowS
`combine` [Option] -> String
f [Option]
os)) }
  where (Matplotlib
l', (Exec String
sl)) = Matplotlib -> (Matplotlib, MplotCommand)
removeLast Matplotlib
l
        removeLast :: Matplotlib -> (Matplotlib, MplotCommand)
removeLast x :: Matplotlib
x@(Matplotlib Seq MplotCommand
_ Maybe ([Option] -> MplotCommand)
Nothing Seq MplotCommand
s) = (Matplotlib
x { mpRest :: Seq MplotCommand
mpRest = Int -> Seq MplotCommand -> Seq MplotCommand
forall a. Int -> Seq a -> Seq a
sdeleteAt (Seq MplotCommand -> Int
forall a. Seq a -> Int
S.length Seq MplotCommand
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq MplotCommand
s }
                                                , MplotCommand -> Maybe MplotCommand -> MplotCommand
forall a. a -> Maybe a -> a
fromMaybe (String -> MplotCommand
Exec String
"") (Int -> Seq MplotCommand -> Maybe MplotCommand
forall a. Int -> Seq a -> Maybe a
slookup (Seq MplotCommand -> Int
forall a. Seq a -> Int
S.length Seq MplotCommand
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Seq MplotCommand
s))
        removeLast Matplotlib
_ = String -> (Matplotlib, MplotCommand)
forall a. HasCallStack => String -> a
error String
"TODO complex options"
        -- TODO When containers is >0.5.8 replace these
        slookup :: Int -> Seq a -> Maybe a
slookup Int
i Seq a
s | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq a -> Int
forall a. Seq a -> Int
S.length Seq a
s = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Seq a -> Int -> a
forall a. Seq a -> Int -> a
S.index Seq a
s Int
i
                    | Bool
otherwise      = Maybe a
forall a. Maybe a
Nothing
        sdeleteAt :: Int -> Seq a -> Seq a
sdeleteAt Int
i Seq a
s | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Seq a -> Int
forall a. Seq a -> Int
S.length Seq a
s = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
S.take Int
i Seq a
s Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
S.drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Seq a
s
                      | Bool
otherwise      = Seq a
s
        combine :: String -> ShowS
combine [] String
r = String
r
        combine String
l [] = String
l
        combine String
l String
r | [String -> Char
forall a. [a] -> a
last String
l] String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"(" Bool -> Bool -> Bool
&& [String -> Char
forall a. [a] -> a
head String
r] String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"," = String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. [a] -> [a]
tail String
r
                    | Bool
otherwise = String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
r

-- | Merge two commands with options between
options :: Matplotlib -> Matplotlib
options :: Matplotlib -> Matplotlib
options Matplotlib
l = ([Option] -> String) -> Matplotlib -> Matplotlib
optFn (\[Option]
o -> [Option] -> String
renderOptions [Option]
o) Matplotlib
l

infixl 6 ##
-- | A combinator like '#' that also inserts an option
(##) :: MplotValue val => Matplotlib -> val -> Matplotlib
Matplotlib
m ## :: Matplotlib -> val -> Matplotlib
## val
v = Matplotlib -> Matplotlib
options Matplotlib
m Matplotlib -> val -> Matplotlib
forall val. MplotValue val => Matplotlib -> val -> Matplotlib
# val
v

-- | An internal helper to convert a list of options to the python code that
-- applies those options in a call.
renderOptions :: [Option] -> [Char]
renderOptions :: [Option] -> String
renderOptions [] = String
""
renderOptions [Option]
xs = [Option] -> String
f [Option]
xs
  where  f :: [Option] -> String
f (P String
a:[Option]
l) = String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Option] -> String
f [Option]
l
         f (K String
a String
b:[Option]
l) = String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++  String
"=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Option] -> String
f [Option]
l
         f [] = String
""

-- | An internal helper that modifies the options of a plot.
optionFn :: ([Option] -> [Option]) -> Matplotlib -> Matplotlib
optionFn :: ([Option] -> [Option]) -> Matplotlib -> Matplotlib
optionFn [Option] -> [Option]
f Matplotlib
m = case Matplotlib -> Maybe ([Option] -> MplotCommand)
mpPendingOption Matplotlib
m of
                 (Just [Option] -> MplotCommand
cmd) -> Matplotlib
m { mpPendingOption :: Maybe ([Option] -> MplotCommand)
mpPendingOption = ([Option] -> MplotCommand) -> Maybe ([Option] -> MplotCommand)
forall a. a -> Maybe a
Just (\[Option]
os -> [Option] -> MplotCommand
cmd ([Option] -> MplotCommand) -> [Option] -> MplotCommand
forall a b. (a -> b) -> a -> b
$ [Option] -> [Option]
f [Option]
os) }
                 Maybe ([Option] -> MplotCommand)
Nothing -> String -> Matplotlib
forall a. HasCallStack => String -> a
error String
"Can't apply an option to a non-option command"

-- | Apply a list of options to a plot resolving any pending options.
option :: Matplotlib -> [Option] -> Matplotlib
option :: Matplotlib -> [Option] -> Matplotlib
option Matplotlib
m [Option]
os = Matplotlib -> Matplotlib
resolvePending (Matplotlib -> Matplotlib) -> Matplotlib -> Matplotlib
forall a b. (a -> b) -> a -> b
$ ([Option] -> [Option]) -> Matplotlib -> Matplotlib
optionFn (\[Option]
os' -> [Option]
os [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
os') Matplotlib
m

infixl 6 @@
-- | A combinator for 'option' that applies a list of options to a plot
(@@) :: Matplotlib -> [Option] -> Matplotlib
Matplotlib
m @@ :: Matplotlib -> [Option] -> Matplotlib
@@ [Option]
os = Matplotlib -> [Option] -> Matplotlib
option Matplotlib
m [Option]
os

-- | Bind a list of default options to a plot. Positional options are kept in
-- order and default that way as well. Keyword arguments are also handled
bindDefault :: Matplotlib -> [Option] -> Matplotlib
bindDefault :: Matplotlib -> [Option] -> Matplotlib
bindDefault Matplotlib
m [Option]
os = ([Option] -> [Option]) -> Matplotlib -> Matplotlib
optionFn ([Option] -> [Option] -> [Option]
bindDefaultFn [Option]
os) Matplotlib
m

-- | Merge two sets of options
bindDefaultFn :: [Option] -> [Option] -> [Option]
bindDefaultFn :: [Option] -> [Option] -> [Option]
bindDefaultFn [Option]
os [Option]
os' = [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
merge [Option]
ps' [Option]
ps [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ ([Option] -> [Option]
forall a. Eq a => [a] -> [a]
nub ([Option] -> [Option]) -> [Option] -> [Option]
forall a b. (a -> b) -> a -> b
$ [Option]
ks' [Option] -> [Option] -> [Option]
forall a. [a] -> [a] -> [a]
++ [Option]
ks)
           where isK :: Option -> Bool
isK (K String
_ String
_) = Bool
True
                 isK Option
_ = Bool
False
                 isP :: Option -> Bool
isP (P String
_) = Bool
True
                 isP Option
_ = Bool
False
                 ps :: [Option]
ps  = (Option -> Bool) -> [Option] -> [Option]
forall a. (a -> Bool) -> [a] -> [a]
filter Option -> Bool
isP [Option]
os
                 ps' :: [Option]
ps' = (Option -> Bool) -> [Option] -> [Option]
forall a. (a -> Bool) -> [a] -> [a]
filter Option -> Bool
isP [Option]
os'
                 ks :: [Option]
ks  = (Option -> Bool) -> [Option] -> [Option]
forall a. (a -> Bool) -> [a] -> [a]
filter Option -> Bool
isK [Option]
os
                 ks' :: [Option]
ks' = (Option -> Bool) -> [Option] -> [Option]
forall a. (a -> Bool) -> [a] -> [a]
filter Option -> Bool
isK [Option]
os'
                 merge :: [a] -> [a] -> [a]
merge [a]
l []  = [a]
l
                 merge [] [a]
l' = [a]
l'
                 merge (a
x:[a]
l) (a
_:[a]
l') = (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a] -> [a]
merge [a]
l [a]
l')

-- $ Python operations

-- | Run python given a code string.
python :: Foldable t => t String -> IO (Either String String)
python :: t String -> IO (Either String String)
python t String
codeStr =
  IO (Either String String)
-> (IOException -> IO (Either String String))
-> IO (Either String String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (String
-> (String -> Handle -> IO (Either String String))
-> IO (Either String String)
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
"code.py"
         (\String
codeFile Handle
codeHandle -> do
             t String -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ t String
codeStr (Handle -> String -> IO ()
hPutStrLn Handle
codeHandle)
             Handle -> IO ()
hClose Handle
codeHandle
             String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String)
-> IO String -> IO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"env" [String
"python3", String
codeFile] String
""))
         (\IOException
e -> Either String String -> IO (Either String String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ IOException -> String
forall a. Show a => a -> String
show (IOException
e :: IOException))

pyBackend :: ShowS
pyBackend String
backend = String
"matplotlib.use('" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
backend String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"')"

-- | The standard python includes of every plot
pyIncludes :: String -> [[Char]]
pyIncludes :: String -> [String]
pyIncludes String
backend = [String
"import matplotlib"
                     ,String
backend
                     ,String
"import matplotlib.path as mpath"
                     ,String
"import matplotlib.patches as mpatches"
                     ,String
"import matplotlib.pyplot as plot"
                     ,String
"import matplotlib.cm as cm"
                     ,String
"import matplotlib.colors as mcolors"
                     ,String
"import matplotlib.collections as mcollections"
                     ,String
"import matplotlib.ticker as mticker"
                     ,String
"import matplotlib.image as mpimg"
                     ,String
"from mpl_toolkits.mplot3d import axes3d"
                     ,String
"import numpy as np"
                     ,String
"from scipy import interpolate"
                     ,String
"import os"
                     ,String
"import io"
                     ,String
"import sys"
                     ,String
"import json"
                     ,String
"import random, datetime"
                     ,String
"from matplotlib.dates import DateFormatter, WeekdayLocator"
                     -- We set this rcParams due to:
                     --     bivariateNormal:    /run/user/1000/code12548-89.py:30: MatplotlibDeprecationWarning: shading='flat' when X and Y have the same dimensions as C is deprecated since 3.3.  Either specify the corners of the quadrilaterals with X and Y, or pass shading='auto', 'nearest' or 'gouraud', or set rcParams['pcolor.shading'].  This will become an error two minor releases later.
                     --   plot.sci(ax.pcolor(np.array(data[0]),np.array(data[1]),np.array(data[2]),cmap=r'PuBu_r'))
                     -- /run/user/1000/code12548-89.py:36: MatplotlibDeprecationWarning: shading='flat' when X and Y have the same dimensions as C is deprecated since 3.3.  Either specify the corners of the quadrilaterals with X and Y, or pass shading='auto', 'nearest' or 'gouraud', or set rcParams['pcolor.shading'].  This will become an error two minor releases later.
                     --   plot.sci(ax.pcolor(np.array(data[0]),np.array(data[1]),np.array(data[2]),norm=mcolors.LogNorm(vmin=1.964128034639681e-6, vmax=7.963602137747198),cmap=r'PuBu_r'))
                     ,String
"plot.rcParams['pcolor.shading'] ='auto'"
                     ,String
"fig = plot.gcf()"
                     ,String
"axes = [plot.gca()]"
                     ,String
"ax = axes[0]"]

-- | These will be Python strings and slashes would cause unwanted control characters.
escapeSlashes :: ShowS
escapeSlashes (Char
'\\':String
cs) = Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:Char
'\\'Char -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escapeSlashes String
cs
escapeSlashes (Char
c:String
cs) = Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:ShowS
escapeSlashes String
cs
escapeSlashes [] = []

-- | The python command that reads external data into the python data array
pyReadData :: [Char] -> [[Char]]
pyReadData :: String -> [String]
pyReadData String
filename = [String
"data = json.loads(open('" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeSlashes String
filename String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"').read())"]

-- | The python command that reads an image into the img variable
pyReadImage :: [Char] -> [[Char]]
pyReadImage :: String -> [String]
pyReadImage String
filename = [String
"img = mpimg.imread('" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeSlashes String
filename String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"')"]

-- | Detach python so we don't block (TODO This isn't working reliably)
pyDetach :: [[Char]]
pyDetach :: [String]
pyDetach = [String
"pid = os.fork()"
           ,String
"if(pid != 0):"
           ,String
"  exit(0)"]

-- | Python code to show a plot
pyOnscreen :: [[Char]]
pyOnscreen :: [String]
pyOnscreen = [String
"plot.draw()"
             ,String
"plot.show()"]

-- | Python code that saves a figure
pyFigure :: [Char] -> [[Char]]
pyFigure :: String -> [String]
pyFigure String
output = [String
"plot.savefig('" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
escapeSlashes String
output String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"')"]

-- | Python code that returns SVG for a figure
pySVG :: [[Char]]
pySVG :: [String]
pySVG =
  [String
"i = io.StringIO()"
  ,String
"plot.savefig(i, format='svg')"
  ,String
"print(i.getvalue())"]

-- | Create a positional option
o1 :: val -> Option
o1 val
x = String -> Option
P (String -> Option) -> String -> Option
forall a b. (a -> b) -> a -> b
$ val -> String
forall val. MplotValue val => val -> String
toPythonOpt val
x

-- | Create a keyword option
o2 :: String -> val -> Option
o2 String
x = String -> String -> Option
K String
x (String -> Option) -> (val -> String) -> val -> Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. val -> String
forall val. MplotValue val => val -> String
toPythonOpt

-- | Create a string that will be rendered as a python string
str :: String -> S
str = String -> S
S

-- | Create a string that will be rendered as a raw python string
raw :: String -> R
raw = String -> R
R

-- | Create a literal that will inserted into the python code directly
lit :: String -> L
lit = String -> L
L

-- | Update axes. Should be called any time the state is changed.
updateAxes :: Matplotlib
updateAxes = Matplotlib
mp Matplotlib -> String -> Matplotlib
forall val. MplotValue val => Matplotlib -> val -> Matplotlib
# String
"axes = plot.gcf().get_axes()"

-- | Update the figure and the axes. Should be called any time the state is changed.
updateFigure :: Matplotlib
updateFigure = Matplotlib
mp Matplotlib -> String -> Matplotlib
forall val. MplotValue val => Matplotlib -> val -> Matplotlib
# String
"fig = plot.gcf()"
  Matplotlib -> Matplotlib -> Matplotlib
% Matplotlib
mp Matplotlib -> String -> Matplotlib
forall val. MplotValue val => Matplotlib -> val -> Matplotlib
# String
"axes = plot.gcf().get_axes()"
  Matplotlib -> Matplotlib -> Matplotlib
% Matplotlib
mp Matplotlib -> String -> Matplotlib
forall val. MplotValue val => Matplotlib -> val -> Matplotlib
# String
"ax = axes[0] if len(axes) > 0 else None"

-- | Smallest element of a list of lists
minimum2 :: (Ord (t a), Ord a, Foldable t1, Foldable t) => t1 (t a) -> a
minimum2 :: t1 (t a) -> a
minimum2 t1 (t a)
l = t a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (t a -> a) -> t a -> a
forall a b. (a -> b) -> a -> b
$ t1 (t a) -> t a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum t1 (t a)
l

-- | Largest element of a list of lists
maximum2 :: (Ord (t a), Ord a, Foldable t1, Foldable t) => t1 (t a) -> a
maximum2 :: t1 (t a) -> a
maximum2 t1 (t a)
l = t a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (t a -> a) -> t a -> a
forall a b. (a -> b) -> a -> b
$ t1 (t a) -> t a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum t1 (t a)
l