{-# LANGUAGE DeriveFunctor #-}
module Verismith.Sim.Internal
( ResultSh
, resultSh
, Tool(..)
, Simulator(..)
, Synthesiser(..)
, Failed(..)
, renameSource
, checkPresent
, checkPresentModules
, replace
, replaceMods
, rootPath
, timeout
, timeout_
, bsToI
, noPrint
, logger
, logCommand
, logCommand_
, execute
, execute_
, (<?>)
, annotate
)
where
import Control.Lens
import Control.Monad (forM, void)
import Control.Monad.Catch (throwM)
import Data.Bits (shiftL)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Maybe (catMaybes)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Format (defaultTimeLocale, formatTime)
import Data.Time.LocalTime (getZonedTime)
import Prelude hiding (FilePath)
import Shelly
import Shelly.Lifted (MonadSh, liftSh)
import System.FilePath.Posix (takeBaseName)
import Verismith.Internal
import Verismith.Result
import Verismith.Verilog.AST
class Tool a where
toText :: a -> Text
class Tool a => Simulator a where
runSim :: a
-> SourceInfo
-> [ByteString]
-> ResultSh ByteString
runSimWithFile :: a
-> FilePath
-> [ByteString]
-> ResultSh ByteString
data Failed = EmptyFail
| EquivFail
| EquivError
| SimFail
| SynthFail
| TimeoutError
deriving (Eq, Show)
instance Semigroup Failed where
EmptyFail <> a = a
b <> _ = b
instance Monoid Failed where
mempty = EmptyFail
class Tool a => Synthesiser a where
runSynth :: a
-> SourceInfo
-> ResultSh ()
synthOutput :: a -> FilePath
setSynthOutput :: a -> FilePath -> a
renameSource :: (Synthesiser a) => a -> SourceInfo -> SourceInfo
renameSource a src =
src & infoSrc . _Wrapped . traverse . modId . _Wrapped %~ (<> toText a)
type ResultSh = ResultT Failed Sh
resultSh :: ResultSh a -> Sh a
resultSh s = do
result <- runResultT s
case result of
Fail e -> throwM . RunFailed "" [] 1 $ showT e
Pass s' -> return s'
checkPresent :: FilePath -> Text -> Sh (Maybe Text)
checkPresent fp t = do
errExit False $ run_ "grep" [t, toTextIgnore fp]
i <- lastExitCode
if i == 0 then return $ Just t else return Nothing
checkPresentModules :: FilePath -> SourceInfo -> Sh [Text]
checkPresentModules fp (SourceInfo _ src) = do
vals <- forM (src ^.. _Wrapped . traverse . modId . _Wrapped)
$ checkPresent fp
return $ catMaybes vals
replace :: FilePath -> Text -> Text -> Sh ()
replace fp t1 t2 = do
errExit False . noPrint $ run_
"sed"
["-i", "s/" <> t1 <> "/" <> t2 <> "/g", toTextIgnore fp]
replaceMods :: FilePath -> Text -> SourceInfo -> Sh ()
replaceMods fp t (SourceInfo _ src) =
void
. forM (src ^.. _Wrapped . traverse . modId . _Wrapped)
$ (\a -> replace fp a (a <> t))
rootPath :: Sh FilePath
rootPath = do
current <- pwd
maybe current fromText <$> get_env "VERISMITH_ROOT"
timeout :: FilePath -> [Text] -> Sh Text
timeout = command1 "timeout" ["300"] . toTextIgnore
{-# INLINE timeout #-}
timeout_ :: FilePath -> [Text] -> Sh ()
timeout_ = command1_ "timeout" ["300"] . toTextIgnore
{-# INLINE timeout_ #-}
bsToI :: ByteString -> Integer
bsToI = B.foldl' (\i b -> (i `shiftL` 8) + fromIntegral b) 0
{-# INLINE bsToI #-}
noPrint :: Sh a -> Sh a
noPrint = print_stdout False . print_stderr False
{-# INLINE noPrint #-}
logger :: Text -> Sh ()
logger t = do
fn <- pwd
currentTime <- liftIO getZonedTime
echo
$ "Verismith "
<> T.pack (formatTime defaultTimeLocale "%H:%M:%S " currentTime)
<> bname fn
<> " - "
<> t
where bname = T.pack . takeBaseName . T.unpack . toTextIgnore
logCommand :: FilePath -> Text -> Sh a -> Sh a
logCommand fp name = log_stderr_with (l "_stderr.log")
. log_stdout_with (l ".log")
where
l s t = appendFile (file s) (T.unpack t) >> appendFile (file s) "\n"
file s = T.unpack (toTextIgnore $ fp </> fromText name) <> s
logCommand_ :: FilePath -> Text -> Sh a -> Sh ()
logCommand_ fp name = void . logCommand fp name
execute
:: (MonadSh m, Monad m)
=> Failed
-> FilePath
-> Text
-> FilePath
-> [Text]
-> ResultT Failed m Text
execute f dir name e cs = do
(res, exitCode) <- liftSh $ do
res <- errExit False . logCommand dir name $ timeout e cs
(,) res <$> lastExitCode
case exitCode of
0 -> ResultT . return $ Pass res
124 -> ResultT . return $ Fail TimeoutError
_ -> ResultT . return $ Fail f
execute_
:: (MonadSh m, Monad m)
=> Failed
-> FilePath
-> Text
-> FilePath
-> [Text]
-> ResultT Failed m ()
execute_ a b c d = void . execute a b c d