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
| Exec { es :: String }
deriving (Show, Eq, Ord)
data Option =
K String String
| P String
deriving (Show, Eq, Ord)
toPy :: MplotCommand -> String
toPy (LoadData _) = error "withMplot needed to load data"
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 (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
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) }
class MplotValue val where
toPython :: val -> String
instance MplotValue String where
toPython s = s
instance MplotValue [String] where
toPython [] = ""
toPython (x:xs) = toPython x ++ "," ++ toPython xs
instance MplotValue Double where
toPython s = show s
instance MplotValue Integer where
toPython s = show s
instance MplotValue Int where
toPython s = show s
instance (MplotValue x) => MplotValue (x, x) where
toPython (n, v) = toPython n ++ " = " ++ toPython v
instance (MplotValue (x, y)) => MplotValue [(x, y)] where
toPython [] = ""
toPython (x:xs) = toPython x ++ ", " ++ toPython xs
default (Integer, Int, Double)
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 ++ 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
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) = "," ++ toPython a ++ f l
f (K a b:l) = "," ++ toPython a ++ "=" ++ toPython 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 "/usr/bin/python3" [codeFile] ""))
(\e -> return $ Left $ show (e :: IOException))
pyIncludes :: [[Char]]
pyIncludes = ["import matplotlib"
,"import matplotlib.path as mpath"
,"import matplotlib.patches as mpatches"
,"import matplotlib.pyplot as plot"
,"import matplotlib.mlab as mlab"
,"from matplotlib import cm"
,"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"]
pyReadData :: [Char] -> [[Char]]
pyReadData filename = ["data = json.loads(open('" ++ filename ++ "').read())"]
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 x
o2 x y = K x y