{-# LANGUAGE DeriveFunctor #-}

-- |
-- Module      : Verismith.Tool.Internal
-- Description : Class of the simulator.
-- Copyright   : (c) 2018-2019, Yann Herklotz
-- License     : GPL-3
-- Maintainer  : yann [at] yannherklotz [dot] com
-- Stability   : experimental
-- Portability : POSIX
--
-- Class of the simulator and the synthesize tool.
module Verismith.Tool.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 Shelly
import Shelly.Lifted (MonadSh, liftSh)
import System.FilePath.Posix (takeBaseName)
import Verismith.CounterEg (CounterEg)
import Verismith.Result
import Verismith.Utils
import Verismith.Verilog.AST
import Prelude hiding (FilePath)

-- | Tool class.
class Tool a where
  toText :: a -> Text

-- | Simulation type class.
class (Tool a) => Simulator a where
  runSim ::
    (Show ann) =>
    -- | Simulator instance
    a ->
    -- | Run information
    SourceInfo ann ->
    -- | Inputs to simulate
    [ByteString] ->
    -- | Returns the value of the hash at the output of the testbench.
    ResultSh ByteString
  runSimWithFile ::
    a ->
    FilePath ->
    [ByteString] ->
    ResultSh ByteString

data Failed
  = EmptyFail
  | EquivFail (Maybe CounterEg)
  | EquivError
  | SimFail ByteString
  | SynthFail
  | TimeoutError
  deriving (Failed -> Failed -> Bool
(Failed -> Failed -> Bool)
-> (Failed -> Failed -> Bool) -> Eq Failed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Failed -> Failed -> Bool
== :: Failed -> Failed -> Bool
$c/= :: Failed -> Failed -> Bool
/= :: Failed -> Failed -> Bool
Eq)

instance Show Failed where
  show :: Failed -> String
show Failed
EmptyFail = String
"EmptyFail"
  show (EquivFail Maybe CounterEg
_) = String
"EquivFail"
  show Failed
EquivError = String
"EquivError"
  show (SimFail ByteString
bs) = String
"SimFail " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Int -> Text -> Text
T.take Int
10 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
showBS ByteString
bs)
  show Failed
SynthFail = String
"SynthFail"
  show Failed
TimeoutError = String
"TimeoutError"

instance Semigroup Failed where
  Failed
EmptyFail <> :: Failed -> Failed -> Failed
<> Failed
a = Failed
a
  Failed
b <> Failed
_ = Failed
b

instance Monoid Failed where
  mempty :: Failed
mempty = Failed
EmptyFail

-- | Synthesiser type class.
class (Tool a) => Synthesiser a where
  runSynth ::
    (Show ann) =>
    -- | Synthesiser tool instance
    a ->
    -- | Run information
    SourceInfo ann ->
    -- | does not return any values
    ResultSh ()
  synthOutput :: a -> FilePath
  setSynthOutput :: a -> FilePath -> a

renameSource :: (Synthesiser a) => a -> SourceInfo ann -> SourceInfo ann
renameSource :: forall a ann.
Synthesiser a =>
a -> SourceInfo ann -> SourceInfo ann
renameSource a
a SourceInfo ann
src =
  SourceInfo ann
src SourceInfo ann
-> (SourceInfo ann -> SourceInfo ann) -> SourceInfo ann
forall a b. a -> (a -> b) -> b
& (Verilog ann -> Identity (Verilog ann))
-> SourceInfo ann -> Identity (SourceInfo ann)
forall a1 a2 (f :: * -> *).
Functor f =>
(Verilog a1 -> f (Verilog a2))
-> SourceInfo a1 -> f (SourceInfo a2)
infoSrc ((Verilog ann -> Identity (Verilog ann))
 -> SourceInfo ann -> Identity (SourceInfo ann))
-> ((Text -> Identity Text)
    -> Verilog ann -> Identity (Verilog ann))
-> (Text -> Identity Text)
-> SourceInfo ann
-> Identity (SourceInfo ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ModDecl ann] -> Identity [ModDecl ann])
-> Verilog ann -> Identity (Verilog ann)
(Unwrapped (Verilog ann) -> Identity (Unwrapped (Verilog ann)))
-> Verilog ann -> Identity (Verilog ann)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (Verilog ann)
  (Verilog ann)
  (Unwrapped (Verilog ann))
  (Unwrapped (Verilog ann))
_Wrapped (([ModDecl ann] -> Identity [ModDecl ann])
 -> Verilog ann -> Identity (Verilog ann))
-> ((Text -> Identity Text)
    -> [ModDecl ann] -> Identity [ModDecl ann])
-> (Text -> Identity Text)
-> Verilog ann
-> Identity (Verilog ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModDecl ann -> Identity (ModDecl ann))
-> [ModDecl ann] -> Identity [ModDecl ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((ModDecl ann -> Identity (ModDecl ann))
 -> [ModDecl ann] -> Identity [ModDecl ann])
-> ((Text -> Identity Text)
    -> ModDecl ann -> Identity (ModDecl ann))
-> (Text -> Identity Text)
-> [ModDecl ann]
-> Identity [ModDecl ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> Identity Identifier)
-> ModDecl ann -> Identity (ModDecl ann)
forall a (f :: * -> *).
Applicative f =>
(Identifier -> f Identifier) -> ModDecl a -> f (ModDecl a)
modId ((Identifier -> Identity Identifier)
 -> ModDecl ann -> Identity (ModDecl ann))
-> ((Text -> Identity Text) -> Identifier -> Identity Identifier)
-> (Text -> Identity Text)
-> ModDecl ann
-> Identity (ModDecl ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped Identifier -> Identity (Unwrapped Identifier))
-> Identifier -> Identity Identifier
(Text -> Identity Text) -> Identifier -> Identity Identifier
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  Identifier Identifier (Unwrapped Identifier) (Unwrapped Identifier)
_Wrapped ((Text -> Identity Text)
 -> SourceInfo ann -> Identity (SourceInfo ann))
-> (Text -> Text) -> SourceInfo ann -> SourceInfo ann
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Tool a => a -> Text
toText a
a)

-- | Type synonym for a 'ResultT' that will be used throughout 'Verismith'. This
-- has instances for 'MonadSh' and 'MonadIO' if the 'Monad' it is parametrised
-- with also has those instances.
type ResultSh = ResultT Failed Sh

resultSh :: ResultSh a -> Sh a
resultSh :: forall a. ResultSh a -> Sh a
resultSh ResultSh a
s = do
  Result Failed a
result <- ResultSh a -> Sh (Result Failed a)
forall a (m :: * -> *) b. ResultT a m b -> m (Result a b)
runResultT ResultSh a
s
  case Result Failed a
result of
    Fail Failed
e -> RunFailed -> Sh a
forall e a. (HasCallStack, Exception e) => e -> Sh a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (RunFailed -> Sh a) -> (Text -> RunFailed) -> Text -> Sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Text] -> Int -> Text -> RunFailed
RunFailed String
"" [] Int
1 (Text -> Sh a) -> Text -> Sh a
forall a b. (a -> b) -> a -> b
$ Failed -> Text
forall a. Show a => a -> Text
showT Failed
e
    Pass a
s' -> a -> Sh a
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return a
s'

checkPresent :: FilePath -> Text -> Sh (Maybe Text)
checkPresent :: String -> Text -> Sh (Maybe Text)
checkPresent String
fp Text
t = do
  Bool -> Sh () -> Sh ()
forall a. Bool -> Sh a -> Sh a
errExit Bool
False (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> Sh ()
run_ String
"grep" [Text
t, String -> Text
toTextIgnore String
fp]
  Int
i <- Sh Int
lastExitCode
  if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Maybe Text -> Sh (Maybe Text)
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> Sh (Maybe Text)) -> Maybe Text -> Sh (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t else Maybe Text -> Sh (Maybe Text)
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing

-- | Checks what modules are present in the synthesised output, as some modules
-- may have been inlined. This could be improved if the parser worked properly.
checkPresentModules :: FilePath -> SourceInfo ann -> Sh [Text]
checkPresentModules :: forall ann. String -> SourceInfo ann -> Sh [Text]
checkPresentModules String
fp (SourceInfo Text
_ Verilog ann
src) = do
  [Maybe Text]
vals <-
    [Text] -> (Text -> Sh (Maybe Text)) -> Sh [Maybe Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Verilog ann
src Verilog ann -> Getting (Endo [Text]) (Verilog ann) Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([ModDecl ann] -> Const (Endo [Text]) [ModDecl ann])
-> Verilog ann -> Const (Endo [Text]) (Verilog ann)
(Unwrapped (Verilog ann)
 -> Const (Endo [Text]) (Unwrapped (Verilog ann)))
-> Verilog ann -> Const (Endo [Text]) (Verilog ann)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (Verilog ann)
  (Verilog ann)
  (Unwrapped (Verilog ann))
  (Unwrapped (Verilog ann))
_Wrapped (([ModDecl ann] -> Const (Endo [Text]) [ModDecl ann])
 -> Verilog ann -> Const (Endo [Text]) (Verilog ann))
-> ((Text -> Const (Endo [Text]) Text)
    -> [ModDecl ann] -> Const (Endo [Text]) [ModDecl ann])
-> Getting (Endo [Text]) (Verilog ann) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModDecl ann -> Const (Endo [Text]) (ModDecl ann))
-> [ModDecl ann] -> Const (Endo [Text]) [ModDecl ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((ModDecl ann -> Const (Endo [Text]) (ModDecl ann))
 -> [ModDecl ann] -> Const (Endo [Text]) [ModDecl ann])
-> ((Text -> Const (Endo [Text]) Text)
    -> ModDecl ann -> Const (Endo [Text]) (ModDecl ann))
-> (Text -> Const (Endo [Text]) Text)
-> [ModDecl ann]
-> Const (Endo [Text]) [ModDecl ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> Const (Endo [Text]) Identifier)
-> ModDecl ann -> Const (Endo [Text]) (ModDecl ann)
forall a (f :: * -> *).
Applicative f =>
(Identifier -> f Identifier) -> ModDecl a -> f (ModDecl a)
modId ((Identifier -> Const (Endo [Text]) Identifier)
 -> ModDecl ann -> Const (Endo [Text]) (ModDecl ann))
-> ((Text -> Const (Endo [Text]) Text)
    -> Identifier -> Const (Endo [Text]) Identifier)
-> (Text -> Const (Endo [Text]) Text)
-> ModDecl ann
-> Const (Endo [Text]) (ModDecl ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped Identifier
 -> Const (Endo [Text]) (Unwrapped Identifier))
-> Identifier -> Const (Endo [Text]) Identifier
(Text -> Const (Endo [Text]) Text)
-> Identifier -> Const (Endo [Text]) Identifier
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  Identifier Identifier (Unwrapped Identifier) (Unwrapped Identifier)
_Wrapped) ((Text -> Sh (Maybe Text)) -> Sh [Maybe Text])
-> (Text -> Sh (Maybe Text)) -> Sh [Maybe Text]
forall a b. (a -> b) -> a -> b
$
      String -> Text -> Sh (Maybe Text)
checkPresent String
fp
  [Text] -> Sh [Text]
forall a. a -> Sh a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Sh [Text]) -> [Text] -> Sh [Text]
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Text]
vals

-- | Uses sed to replace a string in a text file.
replace :: FilePath -> Text -> Text -> Sh ()
replace :: String -> Text -> Text -> Sh ()
replace String
fp Text
t1 Text
t2 = do
  Bool -> Sh () -> Sh ()
forall a. Bool -> Sh a -> Sh a
errExit Bool
False (Sh () -> Sh ()) -> (Sh () -> Sh ()) -> Sh () -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sh () -> Sh ()
forall a. Sh a -> Sh a
noPrint (Sh () -> Sh ()) -> Sh () -> Sh ()
forall a b. (a -> b) -> a -> b
$
    String -> [Text] -> Sh ()
run_
      String
"sed"
      [Text
"-i", Text
"s/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/g", String -> Text
toTextIgnore String
fp]

-- | This is used because rename only renames the definitions of modules of
-- course, so instead this just searches and replaces all the module names. This
-- should find all the instantiations and definitions. This could again be made
-- much simpler if the parser works.
replaceMods :: FilePath -> Text -> SourceInfo ann -> Sh ()
replaceMods :: forall ann. String -> Text -> SourceInfo ann -> Sh ()
replaceMods String
fp Text
t (SourceInfo Text
_ Verilog ann
src) =
  Sh [()] -> Sh ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
    (Sh [()] -> Sh ())
-> ((Text -> Sh ()) -> Sh [()]) -> (Text -> Sh ()) -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> (Text -> Sh ()) -> Sh [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Verilog ann
src Verilog ann -> Getting (Endo [Text]) (Verilog ann) Text -> [Text]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([ModDecl ann] -> Const (Endo [Text]) [ModDecl ann])
-> Verilog ann -> Const (Endo [Text]) (Verilog ann)
(Unwrapped (Verilog ann)
 -> Const (Endo [Text]) (Unwrapped (Verilog ann)))
-> Verilog ann -> Const (Endo [Text]) (Verilog ann)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  (Verilog ann)
  (Verilog ann)
  (Unwrapped (Verilog ann))
  (Unwrapped (Verilog ann))
_Wrapped (([ModDecl ann] -> Const (Endo [Text]) [ModDecl ann])
 -> Verilog ann -> Const (Endo [Text]) (Verilog ann))
-> ((Text -> Const (Endo [Text]) Text)
    -> [ModDecl ann] -> Const (Endo [Text]) [ModDecl ann])
-> Getting (Endo [Text]) (Verilog ann) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModDecl ann -> Const (Endo [Text]) (ModDecl ann))
-> [ModDecl ann] -> Const (Endo [Text]) [ModDecl ann]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((ModDecl ann -> Const (Endo [Text]) (ModDecl ann))
 -> [ModDecl ann] -> Const (Endo [Text]) [ModDecl ann])
-> ((Text -> Const (Endo [Text]) Text)
    -> ModDecl ann -> Const (Endo [Text]) (ModDecl ann))
-> (Text -> Const (Endo [Text]) Text)
-> [ModDecl ann]
-> Const (Endo [Text]) [ModDecl ann]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier -> Const (Endo [Text]) Identifier)
-> ModDecl ann -> Const (Endo [Text]) (ModDecl ann)
forall a (f :: * -> *).
Applicative f =>
(Identifier -> f Identifier) -> ModDecl a -> f (ModDecl a)
modId ((Identifier -> Const (Endo [Text]) Identifier)
 -> ModDecl ann -> Const (Endo [Text]) (ModDecl ann))
-> ((Text -> Const (Endo [Text]) Text)
    -> Identifier -> Const (Endo [Text]) Identifier)
-> (Text -> Const (Endo [Text]) Text)
-> ModDecl ann
-> Const (Endo [Text]) (ModDecl ann)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Unwrapped Identifier
 -> Const (Endo [Text]) (Unwrapped Identifier))
-> Identifier -> Const (Endo [Text]) Identifier
(Text -> Const (Endo [Text]) Text)
-> Identifier -> Const (Endo [Text]) Identifier
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
Iso
  Identifier Identifier (Unwrapped Identifier) (Unwrapped Identifier)
_Wrapped)
    ((Text -> Sh ()) -> Sh ()) -> (Text -> Sh ()) -> Sh ()
forall a b. (a -> b) -> a -> b
$ (\Text
a -> String -> Text -> Text -> Sh ()
replace String
fp Text
a (Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t))

rootPath :: Sh FilePath
rootPath :: Sh String
rootPath = do
  String
current <- Sh String
pwd
  String -> (Text -> String) -> Maybe Text -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
current Text -> String
fromText (Maybe Text -> String) -> Sh (Maybe Text) -> Sh String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Sh (Maybe Text)
get_env Text
"VERISMITH_ROOT"

timeout :: FilePath -> [Text] -> Sh Text
timeout :: String -> [Text] -> Sh Text
timeout = String -> [Text] -> Text -> [Text] -> Sh Text
command1 String
"timeout" [Text
"300"] (Text -> [Text] -> Sh Text)
-> (String -> Text) -> String -> [Text] -> Sh Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
toTextIgnore
{-# INLINE timeout #-}

timeout_ :: FilePath -> [Text] -> Sh ()
timeout_ :: String -> [Text] -> Sh ()
timeout_ = String -> [Text] -> Text -> [Text] -> Sh ()
command1_ String
"timeout" [Text
"300"] (Text -> [Text] -> Sh ())
-> (String -> Text) -> String -> [Text] -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
toTextIgnore
{-# INLINE timeout_ #-}

-- | Helper function to convert bytestrings to integers
bsToI :: ByteString -> Integer
bsToI :: ByteString -> Integer
bsToI = (Integer -> Word8 -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' (\Integer
i Word8
b -> (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftL` Int
8) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word8 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
b) Integer
0
{-# INLINE bsToI #-}

noPrint :: Sh a -> Sh a
noPrint :: forall a. Sh a -> Sh a
noPrint = Bool -> Sh a -> Sh a
forall a. Bool -> Sh a -> Sh a
print_stdout Bool
False (Sh a -> Sh a) -> (Sh a -> Sh a) -> Sh a -> Sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Sh a -> Sh a
forall a. Bool -> Sh a -> Sh a
print_stderr Bool
False
{-# INLINE noPrint #-}

logger :: Text -> Sh ()
logger :: Text -> Sh ()
logger Text
t = do
  String
fn <- Sh String
pwd
  ZonedTime
currentTime <- IO ZonedTime -> Sh ZonedTime
forall a. IO a -> Sh a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
  Text -> Sh ()
echo (Text -> Sh ()) -> Text -> Sh ()
forall a b. (a -> b) -> a -> b
$
    Text
"Verismith "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%H:%M:%S " ZonedTime
currentTime)
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
bname String
fn
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" - "
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
  where
    bname :: String -> Text
bname = String -> Text
T.pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeBaseName ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (String -> Text) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
toTextIgnore

logCommand :: FilePath -> Text -> Sh a -> Sh a
logCommand :: forall a. String -> Text -> Sh a -> Sh a
logCommand String
fp Text
name =
  (Text -> IO ()) -> Sh a -> Sh a
forall a. (Text -> IO ()) -> Sh a -> Sh a
log_stderr_with (String -> Text -> IO ()
l String
"_stderr.log")
    (Sh a -> Sh a) -> (Sh a -> Sh a) -> Sh a -> Sh a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> IO ()) -> Sh a -> Sh a
forall a. (Text -> IO ()) -> Sh a -> Sh a
log_stdout_with (String -> Text -> IO ()
l String
".log")
  where
    l :: String -> Text -> IO ()
l String
s Text
t = String -> String -> IO ()
appendFile (ShowS
file String
s) (Text -> String
T.unpack Text
t) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> String -> IO ()
appendFile (ShowS
file String
s) String
"\n"
    file :: ShowS
file String
s = Text -> String
T.unpack (String -> Text
toTextIgnore (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
fp String -> ShowS
forall filepath1 filepath2.
(ToFilePath filepath1, ToFilePath filepath2) =>
filepath1 -> filepath2 -> String
</> Text -> String
fromText Text
name) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
s

logCommand_ :: FilePath -> Text -> Sh a -> Sh ()
logCommand_ :: forall a. String -> Text -> Sh a -> Sh ()
logCommand_ String
fp Text
name = Sh a -> Sh ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Sh a -> Sh ()) -> (Sh a -> Sh a) -> Sh a -> Sh ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Sh a -> Sh a
forall a. String -> Text -> Sh a -> Sh a
logCommand String
fp Text
name

execute ::
  (MonadSh m, Monad m) =>
  Failed ->
  FilePath ->
  Text ->
  FilePath ->
  [Text] ->
  ResultT Failed m Text
execute :: forall (m :: * -> *).
(MonadSh m, Monad m) =>
Failed
-> String -> Text -> String -> [Text] -> ResultT Failed m Text
execute Failed
f String
dir Text
name String
e [Text]
cs = do
  (Text
res, Int
exitCode) <- Sh (Text, Int) -> ResultT Failed m (Text, Int)
forall a. Sh a -> ResultT Failed m a
forall (m :: * -> *) a. MonadSh m => Sh a -> m a
liftSh (Sh (Text, Int) -> ResultT Failed m (Text, Int))
-> Sh (Text, Int) -> ResultT Failed m (Text, Int)
forall a b. (a -> b) -> a -> b
$ do
    Text
res <- Bool -> Sh Text -> Sh Text
forall a. Bool -> Sh a -> Sh a
errExit Bool
False (Sh Text -> Sh Text) -> (Sh Text -> Sh Text) -> Sh Text -> Sh Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Sh Text -> Sh Text
forall a. String -> Text -> Sh a -> Sh a
logCommand String
dir Text
name (Sh Text -> Sh Text) -> Sh Text -> Sh Text
forall a b. (a -> b) -> a -> b
$ String -> [Text] -> Sh Text
timeout String
e [Text]
cs
    (,) Text
res (Int -> (Text, Int)) -> Sh Int -> Sh (Text, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Sh Int
lastExitCode
  case Int
exitCode of
    Int
0 -> m (Result Failed Text) -> ResultT Failed m Text
forall a (m :: * -> *) b. m (Result a b) -> ResultT a m b
ResultT (m (Result Failed Text) -> ResultT Failed m Text)
-> (Result Failed Text -> m (Result Failed Text))
-> Result Failed Text
-> ResultT Failed m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result Failed Text -> m (Result Failed Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result Failed Text -> ResultT Failed m Text)
-> Result Failed Text -> ResultT Failed m Text
forall a b. (a -> b) -> a -> b
$ Text -> Result Failed Text
forall a b. b -> Result a b
Pass Text
res
    Int
124 -> m (Result Failed Text) -> ResultT Failed m Text
forall a (m :: * -> *) b. m (Result a b) -> ResultT a m b
ResultT (m (Result Failed Text) -> ResultT Failed m Text)
-> (Result Failed Text -> m (Result Failed Text))
-> Result Failed Text
-> ResultT Failed m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result Failed Text -> m (Result Failed Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result Failed Text -> ResultT Failed m Text)
-> Result Failed Text -> ResultT Failed m Text
forall a b. (a -> b) -> a -> b
$ Failed -> Result Failed Text
forall a b. a -> Result a b
Fail Failed
TimeoutError
    Int
_ -> m (Result Failed Text) -> ResultT Failed m Text
forall a (m :: * -> *) b. m (Result a b) -> ResultT a m b
ResultT (m (Result Failed Text) -> ResultT Failed m Text)
-> (Result Failed Text -> m (Result Failed Text))
-> Result Failed Text
-> ResultT Failed m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result Failed Text -> m (Result Failed Text)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result Failed Text -> ResultT Failed m Text)
-> Result Failed Text -> ResultT Failed m Text
forall a b. (a -> b) -> a -> b
$ Failed -> Result Failed Text
forall a b. a -> Result a b
Fail Failed
f

execute_ ::
  (MonadSh m, Monad m) =>
  Failed ->
  FilePath ->
  Text ->
  FilePath ->
  [Text] ->
  ResultT Failed m ()
execute_ :: forall (m :: * -> *).
(MonadSh m, Monad m) =>
Failed -> String -> Text -> String -> [Text] -> ResultT Failed m ()
execute_ Failed
a String
b Text
c String
d = ResultT Failed m Text -> ResultT Failed m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ResultT Failed m Text -> ResultT Failed m ())
-> ([Text] -> ResultT Failed m Text)
-> [Text]
-> ResultT Failed m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Failed
-> String -> Text -> String -> [Text] -> ResultT Failed m Text
forall (m :: * -> *).
(MonadSh m, Monad m) =>
Failed
-> String -> Text -> String -> [Text] -> ResultT Failed m Text
execute Failed
a String
b Text
c String
d