module Graphics.Matplotlib.Internal where
import System.IO.Temp
import System.Process
import Data.Aeson
import Control.Monad
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 GHC.Exts(toList)
mapLinear :: (Double -> b) -> Double -> Double -> Double -> [b]
mapLinear f s e n = map (\v -> f $ s + (v * (e s) / n)) [0..n]
data Matplotlib = Matplotlib {
mpCommands :: Seq MplotCommand
, mpPendingOption :: Maybe ([Option] -> MplotCommand)
, mpRest :: Seq MplotCommand
}
data MplotCommand =
LoadData B.ByteString
| forall x. MplotImage x => LoadImage x
| Exec { es :: String }
data Option =
K String String
| P String
deriving (Show, Eq, Ord)
toPy :: MplotCommand -> String
toPy (LoadData _) = error "withMplot needed to load data"
toPy (LoadImage _) = error "withMplot needed to load images"
toPy (Exec str) = str
resolvePending :: Matplotlib -> Matplotlib
resolvePending m = m { mpCommands =
(maybe (mpCommands m)
(\pendingCommand -> (mpCommands m |> pendingCommand []))
$ mpPendingOption m) >< mpRest m
, mpPendingOption = Nothing
, mpRest = S.empty}
withMplot :: Matplotlib -> ([String] -> IO a) -> IO a
withMplot m f = preload cs []
where
cs = toList $ mpCommands $ resolvePending m
preload [] cmds = f $ map toPy $ reverse cmds
preload ((LoadData obj):l) cmds =
withSystemTempFile "data.json"
(\dataFile dataHandle -> do
B.hPutStr dataHandle obj
hClose dataHandle
preload l $ ((map Exec $ pyReadData dataFile) ++ cmds))
preload ((LoadImage img):l) cmds = do
withSystemTempFile "data.json" $
(\dataFile dataHandle -> do
hClose dataHandle
obj <- saveHaskellImage img dataFile
preload l $ ([Exec $ "img = " ++ (loadPythonImage img obj dataFile)] ++ cmds))
preload (c:l) cmds = preload l (c:cmds)
mplotString :: String -> Matplotlib
mplotString s = Matplotlib S.empty Nothing (S.singleton $ Exec s)
mp :: Matplotlib
mp = Matplotlib S.empty Nothing S.empty
readData :: ToJSON a => a -> Matplotlib
readData d = Matplotlib (S.singleton $ LoadData $ encode d) Nothing S.empty
readImage :: MplotImage i => i -> Matplotlib
readImage i = Matplotlib (S.singleton $ LoadImage i) Nothing S.empty
infixl 5 %
(%) :: Matplotlib -> Matplotlib -> Matplotlib
a % b | isJust $ mpPendingOption b = b { mpCommands = mpCommands (resolvePending a) >< mpCommands b }
| otherwise = a { mpRest = mpRest a >< mpCommands b >< mpRest b }
infixl 6 #
(#) :: (MplotValue val) => Matplotlib -> val -> Matplotlib
m # v | S.null $ mpRest m =
case mpPendingOption m of
Nothing -> m { mpRest = S.singleton $ Exec $ toPython v }
(Just f) -> m { mpPendingOption = Just (\o -> Exec $ es (f o) ++ toPython v)}
| otherwise = m { mpRest = S.adjust (\(Exec s) -> Exec $ s ++ toPython v) (S.length (mpRest m) 1) (mpRest m) }
data S = S String
deriving (Show, Eq, Ord)
data R = R String
deriving (Show, Eq, Ord)
data L = L String
deriving (Show, Eq, Ord)
class MplotValue val where
toPython :: val -> String
toPythonOpt :: val -> String
toPythonOpt = toPython
instance MplotValue S where
toPython (S s) = "'" ++ s ++ "'"
instance MplotValue R where
toPython (R s) = "r'" ++ s ++ "'"
instance MplotValue L where
toPython (L s) = s
instance MplotValue String where
toPython s = s
toPythonOpt s = toPythonOpt $ S s
instance MplotValue [String] where
toPython [] = ""
toPython (x:xs) = toPython x ++ "," ++ toPython xs
toPythonOpt s = "[" ++ f s ++ "]"
where f [] = ""
f (x:xs) = toPythonOpt (str x) ++ "," ++ f xs
instance MplotValue Double where
toPython s = show s
instance MplotValue [Double] where
toPython s = "[" ++ f s ++ "]"
where f [] = ""
f (x:xs) = toPython x ++ "," ++ f xs
instance MplotValue Integer where
toPython s = show s
instance MplotValue [Integer] where
toPython s = "[" ++ f s ++ "]"
where f [] = ""
f (x:xs) = toPython x ++ "," ++ f xs
instance MplotValue Int where
toPython s = show s
instance MplotValue [Int] where
toPython s = "[" ++ f s ++ "]"
where f [] = ""
f (x:xs) = toPython x ++ "," ++ f xs
instance MplotValue [R] where
toPython s = "[" ++ f s ++ "]"
where f [] = ""
f (x:xs) = toPython x ++ "," ++ f xs
instance MplotValue [S] where
toPython s = "[" ++ f s ++ "]"
where f [] = ""
f (x:xs) = toPython x ++ "," ++ f xs
instance MplotValue [L] where
toPython s = "[" ++ f s ++ "]"
where f [] = ""
f (x:xs) = toPython x ++ "," ++ f xs
instance MplotValue Bool where
toPython s = show s
instance (MplotValue x) => MplotValue (x, x) where
toPython (k, v) = "(" ++ toPython k ++ ", " ++ toPython v ++ ")"
instance (MplotValue (x, y)) => MplotValue [(x, y)] where
toPython s = "[" ++ f s ++ "]"
where f [] = ""
f (x:xs) = toPython x ++ "," ++ f xs
instance MplotValue x => MplotValue (Maybe x) where
toPython Nothing = "None"
toPython (Just x) = toPython x
instance MplotValue [[Double]] where
toPython s = "np.asarray([" ++ f s ++ "])"
where f [] = ""
f (x:xs) = toPython x ++ "," ++ f xs
default (Integer, Int, Double)
class MplotImage a where
saveHaskellImage :: a -> FilePath -> IO String
loadPythonImage :: a -> String -> FilePath -> String
instance MplotImage String where
saveHaskellImage _ _ = return ""
loadPythonImage s _ _ = "mpimg.imread('" ++ toPython s ++ "')"
instance ToJSON a => MplotImage [[a]] where
saveHaskellImage d fp = (B.writeFile fp $ encode d) >> return ""
loadPythonImage s _ fp = unlines $ pyReadData fp
optFn :: ([Option] -> String) -> Matplotlib -> Matplotlib
optFn f l | isJust $ mpPendingOption l = error "Commands can have only open option. TODO Enforce this through the type system or relax it!"
| otherwise = l' { mpPendingOption = Just (\os -> Exec (sl `combine` f os)) }
where (l', (Exec sl)) = removeLast l
removeLast x@(Matplotlib _ Nothing s) = (x { mpRest = sdeleteAt (S.length s 1) s }
, fromMaybe (Exec "") (slookup (S.length s 1) s))
removeLast _ = error "TODO complex options"
slookup i s | i < S.length s = Just $ S.index s i
| otherwise = Nothing
sdeleteAt i s | i < S.length s = S.take i s >< S.drop (i + 1) s
| otherwise = s
combine [] r = r
combine l [] = l
combine l r | [last l] == "(" && [head r] == "," = l ++ tail r
| otherwise = l ++ r
options :: Matplotlib -> Matplotlib
options l = optFn (\o -> renderOptions o) l
infixl 6 ##
(##) :: MplotValue val => Matplotlib -> val -> Matplotlib
m ## v = options m # v
renderOptions :: [Option] -> [Char]
renderOptions [] = ""
renderOptions xs = f xs
where f (P a:l) = "," ++ a ++ f l
f (K a b:l) = "," ++ a ++ "=" ++ b ++ f l
f [] = ""
optionFn :: ([Option] -> [Option]) -> Matplotlib -> Matplotlib
optionFn f m = case mpPendingOption m of
(Just cmd) -> m { mpPendingOption = Just (\os -> cmd $ f os) }
Nothing -> error "Can't apply an option to a non-option command"
option :: Matplotlib -> [Option] -> Matplotlib
option m os = resolvePending $ optionFn (\os' -> os ++ os') m
infixl 6 @@
(@@) :: Matplotlib -> [Option] -> Matplotlib
m @@ os = option m os
def :: Matplotlib -> [Option] -> Matplotlib
def m os = optionFn (defFn os) m
defFn :: [Option] -> [Option] -> [Option]
defFn os os' = merge ps' ps ++ (nub $ ks' ++ ks)
where isK (K _ _) = True
isK _ = False
isP (P _) = True
isP _ = False
ps = filter isP os
ps' = filter isP os'
ks = filter isK os
ks' = filter isK os'
merge l [] = l
merge [] l' = l'
merge (x:l) (_:l') = (x : merge l l')
python :: Foldable t => t String -> IO (Either String String)
python codeStr =
catch (withSystemTempFile "code.py"
(\codeFile codeHandle -> do
forM_ codeStr (hPutStrLn codeHandle)
hClose codeHandle
Right <$> readProcess "env" ["python3", codeFile] ""))
(\e -> return $ Left $ show (e :: IOException))
pyBackend backend = "matplotlib.use('" ++ backend ++ "')"
pyIncludes :: String -> [[Char]]
pyIncludes backend = ["import matplotlib"
,backend
,"import matplotlib.path as mpath"
,"import matplotlib.patches as mpatches"
,"import matplotlib.pyplot as plot"
,"import matplotlib.mlab as mlab"
,"import matplotlib.cm as cm"
,"import matplotlib.colors as mcolors"
,"import matplotlib.collections as mcollections"
,"import matplotlib.ticker as mticker"
,"import matplotlib.image as mpimg"
,"from mpl_toolkits.mplot3d import axes3d"
,"import numpy as np"
,"import os"
,"import sys"
,"import json"
,"import random, datetime"
,"from matplotlib.dates import DateFormatter, WeekdayLocator"
,"fig = plot.gcf()"
,"axes = [plot.gca()]"
,"ax = axes[0]"]
pyReadData :: [Char] -> [[Char]]
pyReadData filename = ["data = json.loads(open('" ++ filename ++ "').read())"]
pyReadImage :: [Char] -> [[Char]]
pyReadImage filename = ["img = mpimg.imread('" ++ filename ++ "')"]
pyDetach :: [[Char]]
pyDetach = ["pid = os.fork()"
,"if(pid != 0):"
," exit(0)"]
pyOnscreen :: [[Char]]
pyOnscreen = ["plot.draw()"
,"plot.show()"]
pyFigure :: [Char] -> [[Char]]
pyFigure output = ["plot.savefig('" ++ output ++ "')"]
o1 x = P $ toPythonOpt x
o2 x = K x . toPythonOpt
str = S
raw = R
lit = L
updateAxes = mp # "axes = plot.gcf().get_axes()"
updateFigure = mp # "fig = plot.gcf()"
% mp # "axes = plot.gcf().get_axes()"
% mp # "ax = axes[0] if len(axes) > 0 else None"
minimum2 :: (Ord (t a), Ord a, Foldable t1, Foldable t) => t1 (t a) -> a
minimum2 l = minimum $ minimum l
maximum2 :: (Ord (t a), Ord a, Foldable t1, Foldable t) => t1 (t a) -> a
maximum2 l = maximum $ maximum l