{-# OPTIONS_GHC -Wall #-}

{-# LANGUAGE StrictData #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Interactive Communication between Haskell and Spectre
module Spectre.Interactive ( -- * Types
                             Session (..), Parameter
                           -- * Session Management
                           , startSession, startSession', stopSession
                           -- * Running Simulations
                           , runAll, runAll_, results
                           , listAnalysis, runAnalysis, sweep
                           -- * Netlist Parameters
                           , getParameter, setParameter
                           , getParameters, setParameters
                           ) where

import           Spectre
import qualified Data.ByteString       as BS
import qualified Data.ByteString.Char8 as CS
import           Data.Char
import qualified Data.Map              as M
import           Data.Maybe                  (fromJust)
import           Data.NutMeg                 (NutMeg)
import qualified Data.NutMeg           as N
import           Control.Monad               (when)
import           System.Process
import           System.Posix.Pty
import           System.IO.Temp
import           System.Directory
import           Text.RawString.QQ
import           Text.Regex.TDFA

-- | Spectre Commands
data Command = Close                        -- ^ Quit the Session
             | RunAll                       -- ^ Run all simulation analyses
             | ListAnalysis                 -- ^ Retrieve Analyses in netlist
             | RunAnalysis  !String         -- ^ Run specified analysis
             | SetAttribute !String !Double -- ^ Alter a Parameter
             | GetAttribute !String         -- ^ Get Parameter Value

instance Show Command where
  show :: Command -> String
show Command
Close              = String
"(sclQuit)"
  show Command
RunAll             = String
"(sclRun \"all\")"
  show Command
ListAnalysis       = String
"(sclListAnalysis)"
  show (RunAnalysis  String
a)   = String
"(sclRunAnalysis (sclGetAnalysis " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
a) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"))"
  show (SetAttribute String
a Double
v) = String
"(sclSetAttribute (sclGetParameter (sclGetCircuit \"\") "
                                String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") \"value\" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
v String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (GetAttribute String
a)   = String
"(sclGetAttribute (sclGetParameter (sclGetCircuit \"\") "
                                String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") \"value\")"
-- | Write command
writeCommand :: Command -> BS.ByteString
writeCommand :: Command -> ByteString
writeCommand Command
cmd = String -> ByteString
CS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Command -> String
forall a. Show a => a -> String
show Command
cmd String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"

-- | Spectre Interactive Session
data Session = Session { Session -> Pty
pty    :: !Pty      -- ^ The pseudo terminal
                       , Session -> String
dir    :: !FilePath -- ^ Simulation data directory
                       }

-- | Name of a netlist Parameter
type Parameter = String

-- | Spectre Interactive mode Prompt
prompt :: BS.ByteString
prompt :: ByteString
prompt = ByteString
"> " :: BS.ByteString

-- | Consume all output from Pty
consumeOutput :: Pty -> IO BS.ByteString
consumeOutput :: Pty -> IO ByteString
consumeOutput Pty
pty' = do
    !ByteString
output <- Pty -> IO ()
drainOutput Pty
pty' IO () -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pty -> IO ByteString
readPty Pty
pty'
    if ByteString -> ByteString -> Bool
BS.isSuffixOf ByteString
prompt ByteString
output 
       then ByteString -> IO ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
output 
       else ByteString -> ByteString -> ByteString
BS.append ByteString
output (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pty -> IO ByteString
consumeOutput Pty
pty'

-- | Discard output from session terminal
discardOutput :: Pty -> IO ()
discardOutput :: Pty -> IO ()
discardOutput Pty
pty' = do
    !ByteString
_ <- Pty -> IO ByteString
consumeOutput Pty
pty' 
    () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Initialize spectre session with given include path and netlist
startSession' :: [FilePath] -> FilePath -> IO Session
startSession' :: [String] -> String -> IO Session
startSession' [String]
includes String
netlist = String -> String -> IO String
createTempDirectory String
"/tmp" String
"hspectre" 
                                    IO String -> (String -> IO Session) -> IO Session
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> String -> String -> IO Session
startSession [String]
includes String
netlist

-- | Initialize spectre session with given include path, netlist and temp dir
startSession :: [FilePath] -> FilePath -> FilePath -> IO Session
startSession :: [String] -> String -> String -> IO Session
startSession [String]
inc String
net String
dir' = do
    String -> IO Bool
doesFileExist String
log' IO Bool -> (Bool -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO () -> IO ()) -> IO () -> Bool -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> IO ()
removeFile String
log')
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dir'

    !ProcessHandle
_ <- String -> IO ProcessHandle
spawnCommand (String -> IO ProcessHandle) -> String -> IO ProcessHandle
forall a b. (a -> b) -> a -> b
$! String
"mkfifo " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
log'
    Pty
pty' <- (Pty, ProcessHandle) -> Pty
forall a b. (a, b) -> a
fst ((Pty, ProcessHandle) -> Pty) -> IO (Pty, ProcessHandle) -> IO Pty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [(String, String)]
-> Bool
-> String
-> [String]
-> (Int, Int)
-> IO (Pty, ProcessHandle)
spawnWithPty Maybe [(String, String)]
forall a. Maybe a
Nothing Bool
True String
spectre [String]
args (Int
80,Int
100)
    !ProcessHandle
_ <- String -> IO ProcessHandle
spawnCommand (String -> IO ProcessHandle) -> String -> IO ProcessHandle
forall a b. (a -> b) -> a -> b
$! String
"cat "    String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
log' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" > /dev/null &"

    let session :: Session
session = Pty -> String -> Session
Session Pty
pty' String
dir'

    !ByteString
_ <- Pty -> IO ()
threadWaitReadPty Pty
pty' IO () -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pty -> IO ByteString
consumeOutput Pty
pty'

    Session -> IO Session
forall (f :: * -> *) a. Applicative f => a -> f a
pure Session
session
  where
    spectre :: String
spectre = String
"spectre"
    ahdl :: String
ahdl    = String
dir' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/ahdl"
    raw :: String
raw     = String
dir' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/hspectre.raw"
    log' :: String
log'    = String
dir' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/hspectre.log"
    args :: [String]
args    = [ String
"-64", String
"+interactive"
              , String
"-format nutbin"
              , String
"-ahdllibdir " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ahdl
              , String
"+multithread"
              , String
"=log " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
log'
              , String
"-raw " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
raw
              ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"-I" String -> ShowS
forall a. [a] -> [a] -> [a]
++) [String]
inc [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [ String
net ]

-- | Execute a spectre Command which changes the state but returns nothing
exec_ :: Session -> Command -> IO ()
exec_ :: Session -> Command -> IO ()
exec_ Session{String
Pty
dir :: String
pty :: Pty
dir :: Session -> String
pty :: Session -> Pty
..} Command
Close = Pty -> ByteString -> IO ()
writePty Pty
pty (Command -> ByteString
writeCommand Command
Close) IO () -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pty -> IO ByteString
readPty Pty
pty IO ByteString -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
exec_ Session{String
Pty
dir :: String
pty :: Pty
dir :: Session -> String
pty :: Session -> Pty
..} Command
cmd   = Pty -> ByteString -> IO ()
writePty Pty
pty (Command -> ByteString
writeCommand Command
cmd)   IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pty -> IO ()
discardOutput Pty
pty

-- | Execute spectre command and return some result
exec :: Session -> Command -> IO BS.ByteString
exec :: Session -> Command -> IO ByteString
exec Session{String
Pty
dir :: String
pty :: Pty
dir :: Session -> String
pty :: Session -> Pty
..} cmd :: Command
cmd@(GetAttribute String
_) = Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString)
-> (ByteString -> Maybe ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Maybe ByteString
BS.stripSuffix ByteString
"\r" 
                                      (ByteString -> Maybe ByteString)
-> (ByteString -> ByteString) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. [a] -> a
last ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
init ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
CS.lines 
                                     (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Pty -> ByteString -> IO ()
writePty Pty
pty ByteString
cmd' IO () -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pty -> IO ByteString
consumeOutput Pty
pty)
  where
    cmd' :: ByteString
cmd' = Command -> ByteString
writeCommand Command
cmd
exec Session{String
Pty
dir :: String
pty :: Pty
dir :: Session -> String
pty :: Session -> Pty
..} Command
ListAnalysis         = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"\n" ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
parse
                                      ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
")\r") ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
1 ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
CS.lines 
                                     (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( Pty -> ByteString -> IO ()
writePty Pty
pty ByteString
cmd IO () -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pty -> IO ByteString
consumeOutput Pty
pty)
  where
    cmd :: ByteString
cmd = Command -> ByteString
writeCommand Command
ListAnalysis
    rex :: String
rex = [r|"(.+)" *"(.+)\"|]  :: String
    parse :: BS.ByteString -> BS.ByteString
    parse :: ByteString -> ByteString
parse ByteString
bs = let (String
_,String
_,String
_,[String]
grps) = ByteString -> String
CS.unpack ByteString
bs String -> String -> (String, String, String, [String])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
rex :: (String, String, String, [String])
                in String -> ByteString
CS.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
grps
exec Session{String
Pty
dir :: String
pty :: Pty
dir :: Session -> String
pty :: Session -> Pty
..} Command
cmd                  = Pty -> ByteString -> IO ()
writePty Pty
pty (Command -> ByteString
writeCommand Command
cmd) IO () -> IO ByteString -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Pty -> IO ByteString
consumeOutput Pty
pty

-- | Get Simulation Results (Lazy)
results :: Session -> IO NutMeg
results :: Session -> IO NutMeg
results Session{String
Pty
dir :: String
pty :: Pty
dir :: Session -> String
pty :: Session -> Pty
..} = String -> IO NutMeg
N.readFile (String
dir String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/hspectre.raw")

-- | Run all simulation analyses
runAll :: Session -> IO NutMeg
runAll :: Session -> IO NutMeg
runAll Session
session = Session -> Command -> IO ()
exec_ Session
session Command
RunAll IO () -> IO NutMeg -> IO NutMeg
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Session -> IO NutMeg
results Session
session

-- | Run all simulation analyses don't read results
runAll_ :: Session -> IO ()
runAll_ :: Session -> IO ()
runAll_ Session
session = Session -> Command -> IO ()
exec_ Session
session Command
RunAll 

-- | Get Map of Available Simulation Analyses: (id, type)
listAnalysis :: Session -> IO [(String, Analysis)]
listAnalysis :: Session -> IO [(String, Analysis)]
listAnalysis Session
session = (ByteString -> (String, Analysis))
-> [ByteString] -> [(String, Analysis)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Analysis) -> (String, String) -> (String, Analysis)
forall t b a. (t -> b) -> (a, t) -> (a, b)
snd' String -> Analysis
forall a. Read a => String -> a
read ((String, String) -> (String, Analysis))
-> (ByteString -> (String, String))
-> ByteString
-> (String, Analysis)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> (String, String)
forall a. [a] -> (a, a)
asTuple ([String] -> (String, String))
-> (ByteString -> [String]) -> ByteString -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
CS.unpack ([ByteString] -> [String])
-> (ByteString -> [ByteString]) -> ByteString -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
CS.words)
                     ([ByteString] -> [(String, Analysis)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(String, Analysis)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
CS.lines (ByteString -> [(String, Analysis)])
-> IO ByteString -> IO [(String, Analysis)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session -> Command -> IO ByteString
exec Session
session Command
ListAnalysis
  where
    snd' :: (t -> b) -> (a, t) -> (a, b)
snd' t -> b
f (a
a,t
b) = (a
a, t -> b
f t
b)
    asTuple :: [a] -> (a,a)
    asTuple :: [a] -> (a, a)
asTuple [a
a,a
b] = (a
a,a
b)
    asTuple [a]
_     = String -> (a, a)
forall a. HasCallStack => String -> a
error String
"Parser Error"

-- | Run Selected Analysis only
runAnalysis :: Session -> String -> IO NutMeg
runAnalysis :: Session -> String -> IO NutMeg
runAnalysis Session
session String
analysisID = Session -> Command -> IO ()
exec_ Session
session (String -> Command
RunAnalysis String
analysisID) 
                                        IO () -> IO NutMeg -> IO NutMeg
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Session -> IO NutMeg
results Session
session

-- | Get Netlist Parameter
getParameter :: Session -> Parameter -> IO Double
getParameter :: Session -> String -> IO Double
getParameter Session
session String
param = String -> Double
forall a. Read a => String -> a
read (String -> Double)
-> (ByteString -> String) -> ByteString -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
CS.unpack 
                          (ByteString -> Double) -> IO ByteString -> IO Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session -> Command -> IO ByteString
exec Session
session (String -> Command
GetAttribute String
param)

-- | Get a list of Parameters as Map
getParameters :: Session -> [Parameter] -> IO (M.Map Parameter Double)
getParameters :: Session -> [String] -> IO (Map String Double)
getParameters Session
session [String]
params = do
    ![Double]
values <- (String -> IO Double) -> [String] -> IO [Double]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Session -> String -> IO Double
getParameter Session
session) [String]
params
    Map String Double -> IO (Map String Double)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map String Double -> IO (Map String Double))
-> ([(String, Double)] -> Map String Double)
-> [(String, Double)]
-> IO (Map String Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, Double)] -> Map String Double
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, Double)] -> IO (Map String Double))
-> [(String, Double)] -> IO (Map String Double)
forall a b. (a -> b) -> a -> b
$ [String] -> [Double] -> [(String, Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
params [Double]
values

-- | Set Netlist Parameter
setParameter :: Session -> Parameter -> Double -> IO ()
setParameter :: Session -> String -> Double -> IO ()
setParameter Session
session String
param Double
value = Session -> Command -> IO ()
exec_ Session
session (String -> Double -> Command
SetAttribute String
param Double
value)

-- | Get a list of Parameters
setParameters :: Session -> M.Map Parameter Double -> IO (M.Map Parameter ())
setParameters :: Session -> Map String Double -> IO (Map String ())
setParameters Session
session = (String -> Double -> IO ())
-> Map String Double -> IO (Map String ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey (Session -> String -> Double -> IO ()
setParameter Session
session) 

-- | Perform a number of simulation analyses for a given list of parameter maps
-- and read the results only afterwards.
sweep :: Session -> [M.Map Parameter Double] -> IO NutMeg
sweep :: Session -> [Map String Double] -> IO NutMeg
sweep Session
session [Map String Double]
params = (Map String Double -> IO ()) -> [Map String Double] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\Map String Double
p -> Session -> Map String Double -> IO (Map String ())
setParameters Session
session Map String Double
p IO (Map String ()) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Session -> IO ()
runAll_ Session
session) [Map String Double]
params
                        IO () -> IO NutMeg -> IO NutMeg
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Session -> IO NutMeg
results Session
session

-- | Close a spectre interactive session
stopSession :: Session -> IO ()
stopSession :: Session -> IO ()
stopSession s :: Session
s@Session{String
Pty
dir :: String
pty :: Pty
dir :: Session -> String
pty :: Session -> Pty
..} = do
    Session -> Command -> IO ()
exec_ Session
s Command
Close
    Pty -> IO ()
closePty Pty
pty
    String -> IO ()
removeDirectoryRecursive String
dir