{-# OPTIONS_GHC -Wall #-}

{-# LANGUAGE CPP                      #-}
{-# LANGUAGE ForeignFunctionInterface #-}

-- | Exported Functions for Spectre Interaction
module SharedSpectre ( version
                     , simulate
                     , numOfPlots
                     , nameOfPlot
                     , plotByName
                     , plotByIndex
                     , numOfVars
                     , nameOfVar
                     , numOfPoints
                     , waveByName
                     , waveByIndex
                     , isComplex
                     , realData
                     , imagData
                     , startSession
                     , stopSession
                     ) where

import qualified Spectre               as S
import qualified Spectre.Interactive   as SI
import           Data.Complex
import qualified Data.Map              as M
import           Data.Maybe                 (fromJust)
import           Data.NutMeg
import qualified Data.Vector.Unboxed   as V
import           Foreign.C.String
import           Foreign.C.Types
import           Foreign.Ptr
import           Foreign.StablePtr
import           Foreign.Marshal.Array

-- | Get Spectre Version
version :: IO CString
version :: IO CString
version = IO String
S.version IO String -> (String -> IO CString) -> IO CString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO CString
newCString

marshal' :: Ptr CString -> CInt -> CString -> IO ([String], String)
marshal' :: Ptr CString -> CInt -> CString -> IO ([String], String)
marshal' Ptr CString
includes CInt
len CString
netlist = do
    let len' :: Int
len'   = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
len :: Int
    String
netlist'   <- CString -> IO String
peekCString CString
netlist
    [IO String]
includes'' <- (CString -> IO String) -> [CString] -> [IO String]
forall a b. (a -> b) -> [a] -> [b]
map CString -> IO String
peekCString ([CString] -> [IO String]) -> IO [CString] -> IO [IO String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr CString -> IO [CString]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
len' Ptr CString
includes
    [String]
includes'  <- [IO String] -> IO [String]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [IO String]
includes''
    ([String], String) -> IO ([String], String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String]
includes', String
netlist')

-- | Run a Simulation
simulate :: Ptr CString -> CInt -> CString -> IO (StablePtr NutMeg)
simulate :: Ptr CString -> CInt -> CString -> IO (StablePtr NutMeg)
simulate Ptr CString
includes CInt
len CString
netlist = Ptr CString -> CInt -> CString -> IO ([String], String)
marshal' Ptr CString
includes CInt
len CString
netlist
                                    IO ([String], String)
-> (([String], String) -> IO NutMeg) -> IO NutMeg
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([String] -> String -> IO NutMeg)
-> ([String], String) -> IO NutMeg
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [String] -> String -> IO NutMeg
S.simulate
                                    IO NutMeg
-> (NutMeg -> IO (StablePtr NutMeg)) -> IO (StablePtr NutMeg)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NutMeg -> IO (StablePtr NutMeg)
forall a. a -> IO (StablePtr a)
newStablePtr

-- | Launch an interactive session
startSession :: Ptr CString -> CInt -> CString -> IO (StablePtr SI.Session)
startSession :: Ptr CString -> CInt -> CString -> IO (StablePtr Session)
startSession Ptr CString
includes CInt
len CString
netlist = Ptr CString -> CInt -> CString -> IO ([String], String)
marshal' Ptr CString
includes CInt
len CString
netlist
                                        IO ([String], String)
-> (([String], String) -> IO Session) -> IO Session
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([String] -> String -> IO Session)
-> ([String], String) -> IO Session
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [String] -> String -> IO Session
SI.initSession
                                        IO Session
-> (Session -> IO (StablePtr Session)) -> IO (StablePtr Session)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Session -> IO (StablePtr Session)
forall a. a -> IO (StablePtr a)
newStablePtr

-- | Quit Spectre Interactive Session
stopSession :: StablePtr SI.Session -> IO ()
stopSession :: StablePtr Session -> IO ()
stopSession StablePtr Session
session = StablePtr Session -> IO Session
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr Session
session IO Session -> (Session -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Session -> IO ()
SI.exitSession 

-- | Number of Plots in the nutmeg object
numOfPlots :: StablePtr NutMeg -> IO CInt
numOfPlots :: StablePtr NutMeg -> IO CInt
numOfPlots StablePtr NutMeg
nut = do
    NutMeg
nut' <- StablePtr NutMeg -> IO NutMeg
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr NutMeg
nut
    let num :: CInt
num = Integer -> CInt
forall a. Num a => Integer -> a
fromInteger(Integer -> CInt)
-> (Map String NutPlot -> Integer) -> Map String NutPlot -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer)
-> (Map String NutPlot -> Int) -> Map String NutPlot -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String NutPlot -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Map String NutPlot -> CInt) -> Map String NutPlot -> CInt
forall a b. (a -> b) -> a -> b
$ NutMeg -> Map String NutPlot
nutPlots NutMeg
nut' :: CInt
    CInt -> IO CInt
forall (f :: * -> *) a. Applicative f => a -> f a
pure CInt
num

-- | Name of Nut Plot at given index
nameOfPlot :: StablePtr NutMeg -> CInt -> IO CString
nameOfPlot :: StablePtr NutMeg -> CInt -> IO CString
nameOfPlot StablePtr NutMeg
nut CInt
idx = do
    NutMeg
nut' <- StablePtr NutMeg -> IO NutMeg
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr NutMeg
nut
    let idx' :: Int
idx' = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
idx :: Int
        name :: String
name = ([String] -> Int -> String
forall a. [a] -> Int -> a
!!Int
idx') ([String] -> String)
-> (Map String NutPlot -> [String]) -> Map String NutPlot -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String NutPlot -> [String]
forall k a. Map k a -> [k]
M.keys (Map String NutPlot -> String) -> Map String NutPlot -> String
forall a b. (a -> b) -> a -> b
$  NutMeg -> Map String NutPlot
nutPlots NutMeg
nut'
    String -> IO CString
newCString String
name

-- | Get Plot by given name
plotByName :: StablePtr NutMeg -> CString -> IO (StablePtr NutPlot)
plotByName :: StablePtr NutMeg -> CString -> IO (StablePtr NutPlot)
plotByName StablePtr NutMeg
nut CString
name = do
    NutMeg
nut'  <- StablePtr NutMeg -> IO NutMeg
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr NutMeg
nut
    String
name' <- CString -> IO String
peekCString CString
name
    let plt' :: NutPlot
plt' = Maybe NutPlot -> NutPlot
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe NutPlot -> NutPlot)
-> (Map String NutPlot -> Maybe NutPlot)
-> Map String NutPlot
-> NutPlot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Map String NutPlot -> Maybe NutPlot
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name' (Map String NutPlot -> NutPlot) -> Map String NutPlot -> NutPlot
forall a b. (a -> b) -> a -> b
$ NutMeg -> Map String NutPlot
nutPlots NutMeg
nut'
    NutPlot -> IO (StablePtr NutPlot)
forall a. a -> IO (StablePtr a)
newStablePtr NutPlot
plt'

-- | Get Plot at given Index
plotByIndex :: StablePtr NutMeg -> CInt -> IO (StablePtr NutPlot)
plotByIndex :: StablePtr NutMeg -> CInt -> IO (StablePtr NutPlot)
plotByIndex StablePtr NutMeg
nut CInt
idx = StablePtr NutMeg -> CInt -> IO CString
nameOfPlot StablePtr NutMeg
nut CInt
idx IO CString
-> (CString -> IO (StablePtr NutPlot)) -> IO (StablePtr NutPlot)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StablePtr NutMeg -> CString -> IO (StablePtr NutPlot)
plotByName StablePtr NutMeg
nut 

-- | Number of Variables in the nutplot
numOfVars :: StablePtr NutPlot -> IO CInt
numOfVars :: StablePtr NutPlot -> IO CInt
numOfVars StablePtr NutPlot
plt = do
    NutPlot
plt' <- StablePtr NutPlot -> IO NutPlot
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr NutPlot
plt
    let num :: CInt
num = Integer -> CInt
forall a. Num a => Integer -> a
fromInteger (Integer -> CInt) -> (Int -> Integer) -> Int -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ NutPlot -> Int
nutNumVars NutPlot
plt' :: CInt
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Number of Vars: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
num
    CInt -> IO CInt
forall (f :: * -> *) a. Applicative f => a -> f a
pure CInt
num

-- numOfVars plt = fromInteger . toInteger . nutNumVars <$> deRefStablePtr plt

-- | Name of the variable at given index
nameOfVar :: StablePtr NutPlot -> CInt -> IO CString
nameOfVar :: StablePtr NutPlot -> CInt -> IO CString
nameOfVar StablePtr NutPlot
plt CInt
idx = do
    NutPlot
plt' <- StablePtr NutPlot -> IO NutPlot
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr NutPlot
plt
    let idx' :: Int
idx' = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ CInt -> Integer
forall a. Integral a => a -> Integer
toInteger CInt
idx :: Int
        name :: String
name = ([String] -> Int -> String
forall a. [a] -> Int -> a
!!Int
idx') ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ NutPlot -> [String]
nutVariables NutPlot
plt'
    String -> IO CString
newCString String
name

-- | Number of points in Waves
numOfPoints :: StablePtr NutPlot -> IO CInt
numOfPoints :: StablePtr NutPlot -> IO CInt
numOfPoints StablePtr NutPlot
plt = Integer -> CInt
forall a. Num a => Integer -> a
fromInteger (Integer -> CInt) -> (NutPlot -> Integer) -> NutPlot -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (NutPlot -> Int) -> NutPlot -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NutPlot -> Int
nutNumPoints (NutPlot -> CInt) -> IO NutPlot -> IO CInt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr NutPlot -> IO NutPlot
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr NutPlot
plt

-- | Nut Plot Wave by Variable Name
waveByName :: StablePtr NutPlot -> CString -> IO (StablePtr NutWave)
waveByName :: StablePtr NutPlot -> CString -> IO (StablePtr NutWave)
waveByName StablePtr NutPlot
plt CString
name = do
    String
name' <- CString -> IO String
peekCString CString
name
    NutWave
plt' <- Maybe NutWave -> NutWave
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe NutWave -> NutWave)
-> (NutPlot -> Maybe NutWave) -> NutPlot -> NutWave
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Map String NutWave -> Maybe NutWave
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
name' (Map String NutWave -> Maybe NutWave)
-> (NutPlot -> Map String NutWave) -> NutPlot -> Maybe NutWave
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NutPlot -> Map String NutWave
nutData (NutPlot -> NutWave) -> IO NutPlot -> IO NutWave
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StablePtr NutPlot -> IO NutPlot
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr NutPlot
plt
    NutWave -> IO (StablePtr NutWave)
forall a. a -> IO (StablePtr a)
newStablePtr NutWave
plt'

-- | Nut Plot Wave by Variable Index
waveByIndex :: StablePtr NutPlot -> CInt -> IO (StablePtr NutWave)
waveByIndex :: StablePtr NutPlot -> CInt -> IO (StablePtr NutWave)
waveByIndex StablePtr NutPlot
plt CInt
idx = StablePtr NutPlot -> CInt -> IO CString
nameOfVar StablePtr NutPlot
plt CInt
idx IO CString
-> (CString -> IO (StablePtr NutWave)) -> IO (StablePtr NutWave)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StablePtr NutPlot -> CString -> IO (StablePtr NutWave)
waveByName StablePtr NutPlot
plt

-- | Is Complex? 1 = True, 0 = False
isComplex :: StablePtr NutPlot -> IO CInt
isComplex :: StablePtr NutPlot -> IO CInt
isComplex StablePtr NutPlot
plt = do
    NutPlot
plt' <- StablePtr NutPlot -> IO NutPlot
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr NutPlot
plt
    if NutPlot -> NutPlotType
nutPlotType NutPlot
plt' NutPlotType -> NutPlotType -> Bool
forall a. Eq a => a -> a -> Bool
== NutPlotType
NutComplexPlot
       then CInt -> IO CInt
forall (f :: * -> *) a. Applicative f => a -> f a
pure CInt
1
       else CInt -> IO CInt
forall (f :: * -> *) a. Applicative f => a -> f a
pure CInt
0

-- | Real Part of a Vector
realData :: StablePtr NutWave -> Ptr CDouble -> IO ()
realData :: StablePtr NutWave -> Ptr CDouble -> IO ()
realData StablePtr NutWave
wav Ptr CDouble
arr = do
    NutWave
wav' <- StablePtr NutWave -> IO NutWave
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr NutWave
wav
    let dat :: [CDouble]
dat = (Vector (Complex Double) -> [CDouble])
-> (Vector Double -> [CDouble])
-> Either (Vector (Complex Double)) (Vector Double)
-> [CDouble]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((Complex Double -> CDouble) -> [Complex Double] -> [CDouble]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> CDouble
CDouble (Double -> CDouble)
-> (Complex Double -> Double) -> Complex Double -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Complex Double -> Double
forall a. Complex a -> a
realPart) ([Complex Double] -> [CDouble])
-> (Vector (Complex Double) -> [Complex Double])
-> Vector (Complex Double)
-> [CDouble]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Complex Double) -> [Complex Double]
forall a. Unbox a => Vector a -> [a]
V.toList) 
                     ((Double -> CDouble) -> [Double] -> [CDouble]
forall a b. (a -> b) -> [a] -> [b]
map Double -> CDouble
CDouble ([Double] -> [CDouble])
-> (Vector Double -> [Double]) -> Vector Double -> [CDouble]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Double -> [Double]
forall a. Unbox a => Vector a -> [a]
V.toList) 
                     (Either (Vector (Complex Double)) (Vector Double) -> [CDouble])
-> Either (Vector (Complex Double)) (Vector Double) -> [CDouble]
forall a b. (a -> b) -> a -> b
$ NutWave -> Either (Vector (Complex Double)) (Vector Double)
nutWave NutWave
wav'
    Ptr CDouble -> [CDouble] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CDouble
arr [CDouble]
dat

-- | Imaginary Part of vector or empty list if only real
imagData :: StablePtr NutWave -> Ptr CDouble -> IO ()
imagData :: StablePtr NutWave -> Ptr CDouble -> IO ()
imagData StablePtr NutWave
wav Ptr CDouble
arr = do
    NutWave
wav' <- StablePtr NutWave -> IO NutWave
forall a. StablePtr a -> IO a
deRefStablePtr StablePtr NutWave
wav
    let dat :: [CDouble]
dat = (Vector (Complex Double) -> [CDouble])
-> (Vector Double -> [CDouble])
-> Either (Vector (Complex Double)) (Vector Double)
-> [CDouble]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((Complex Double -> CDouble) -> [Complex Double] -> [CDouble]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> CDouble
CDouble (Double -> CDouble)
-> (Complex Double -> Double) -> Complex Double -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Complex Double -> Double
forall a. Complex a -> a
imagPart) ([Complex Double] -> [CDouble])
-> (Vector (Complex Double) -> [Complex Double])
-> Vector (Complex Double)
-> [CDouble]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Complex Double) -> [Complex Double]
forall a. Unbox a => Vector a -> [a]
V.toList) 
                     ([CDouble] -> Vector Double -> [CDouble]
forall a b. a -> b -> a
const []) 
                     (Either (Vector (Complex Double)) (Vector Double) -> [CDouble])
-> Either (Vector (Complex Double)) (Vector Double) -> [CDouble]
forall a b. (a -> b) -> a -> b
$ NutWave -> Either (Vector (Complex Double)) (Vector Double)
nutWave NutWave
wav'
    Ptr CDouble -> [CDouble] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray Ptr CDouble
arr [CDouble]
dat

-- Spectre Exports

foreign export ccall version :: IO CString
foreign export ccall simulate :: Ptr CString -> CInt -> CString 
                              -> IO (StablePtr NutMeg)
foreign export ccall startSession :: Ptr CString -> CInt -> CString 
                                  -> IO (StablePtr SI.Session)
foreign export ccall stopSession :: StablePtr SI.Session -> IO ()

-- Nutmeg Exports

foreign export ccall numOfPlots :: StablePtr NutMeg -> IO CInt
foreign export ccall nameOfPlot :: StablePtr NutMeg -> CInt -> IO CString
foreign export ccall plotByName :: StablePtr NutMeg -> CString -> IO (StablePtr NutPlot)
foreign export ccall plotByIndex :: StablePtr NutMeg -> CInt -> IO (StablePtr NutPlot)
foreign export ccall numOfVars :: StablePtr NutPlot -> IO CInt
foreign export ccall nameOfVar :: StablePtr NutPlot -> CInt -> IO CString
foreign export ccall numOfPoints :: StablePtr NutPlot -> IO CInt
foreign export ccall waveByName :: StablePtr NutPlot -> CString -> IO (StablePtr NutWave)
foreign export ccall waveByIndex :: StablePtr NutPlot -> CInt -> IO (StablePtr NutWave)
foreign export ccall isComplex :: StablePtr NutPlot -> IO CInt
foreign export ccall realData :: StablePtr NutWave -> Ptr CDouble -> IO ()
foreign export ccall imagData :: StablePtr NutWave -> Ptr CDouble -> IO ()