{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
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
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')
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
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
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
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
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
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'
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
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
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
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
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'
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
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
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
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
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 ()
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 ()