{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveFunctor         #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module HaskellCI.Sh (
    Sh (..),
    isComment,
    shToString,
    shlistToString,
    MonadSh (..),
    sh,
    ShM (..),
    runSh,
    liftSh,
    HsCiError (..),
    FromHsCiError (..),
    ) where

import HaskellCI.Prelude

#ifdef MIN_VERSION_ShellCheck
import           ShellCheck.Checker   (checkScript)
import qualified ShellCheck.Interface as SC
#endif

import HaskellCI.Error
import HaskellCI.MonadErr

-------------------------------------------------------------------------------
-- shell command
-------------------------------------------------------------------------------

data Sh
    = Sh String       -- ^ command
    | Comment String  -- ^ comment
  deriving Int -> Sh -> ShowS
[Sh] -> ShowS
Sh -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Sh] -> ShowS
$cshowList :: [Sh] -> ShowS
show :: Sh -> String
$cshow :: Sh -> String
showsPrec :: Int -> Sh -> ShowS
$cshowsPrec :: Int -> Sh -> ShowS
Show

isComment :: Sh -> Bool
isComment :: Sh -> Bool
isComment (Comment String
_) = Bool
True
isComment (Sh String
_)      = Bool
False

shToString :: Sh -> String
shToString :: Sh -> String
shToString (Comment String
c) = String
"# " forall a. [a] -> [a] -> [a]
++ String
c
shToString (Sh String
x)      = String
x

shlistToString :: [Sh] -> String
shlistToString :: [Sh] -> String
shlistToString [Sh]
shs = [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map Sh -> String
shToString [Sh]
shs)

-------------------------------------------------------------------------------
-- class
-------------------------------------------------------------------------------

class Monad m => MonadSh m where
    -- | Write shell command
    sh' :: [Integer] -> String -> m ()

    -- | Write comment
    comment :: String -> m ()

    -- | Commented block.
    --
    -- If the block is empty (or comments only), nothing might be written.
    commentedBlock :: String -> m () -> m ()

sh :: MonadSh m => String -> m ()
sh :: forall (m :: * -> *). MonadSh m => String -> m ()
sh = forall (m :: * -> *). MonadSh m => [Integer] -> String -> m ()
sh'
    [ Integer
2034 -- VAR appears unused. Verify it or export it.
    , Integer
2086 -- SC2086: Double quote to prevent globbing and word splitting.
    , Integer
2002 -- SC2002: Useless cat. Consider 'cmd < file | ..' or 'cmd file | ..' instead.
    -- TODO: because HEREDOC doesn't work
    , Integer
2129 -- SC2129: Consider using { cmd1; cmd2; } >> file instead of individual redirects
    , Integer
2154 -- SC2154: PKGDIR_splitmix is referenced but not assigned.

    , Integer
1102
    , Integer
2046
    , Integer
2210
{-
SC1102: Shells disambiguate $(( differently or not at all. For $(command substitution), add space after $( . For $((arithmetics)), fix parsing errors.
SC2046: Quote this to prevent word splitting.
SC2210: This is a file redirection. Was it supposed to be a comparison or fd operation?
-}

    ]

-------------------------------------------------------------------------------
-- implementation
-------------------------------------------------------------------------------

newtype ShM a = ShM { forall a.
ShM a -> ([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)
unShM :: ([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a) }
  deriving (forall a b. a -> ShM b -> ShM a
forall a b. (a -> b) -> ShM a -> ShM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ShM b -> ShM a
$c<$ :: forall a b. a -> ShM b -> ShM a
fmap :: forall a b. (a -> b) -> ShM a -> ShM b
$cfmap :: forall a b. (a -> b) -> ShM a -> ShM b
Functor)

runSh :: (MonadErr e m, FromHsCiError e) => ShM () -> m [Sh]
runSh :: forall e (m :: * -> *).
(MonadErr e m, FromHsCiError e) =>
ShM () -> m [Sh]
runSh (ShM ([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], ())
f) = case ([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], ())
f forall a. a -> a
id of
    Left HsCiError
err      -> forall e (m :: * -> *) a. MonadErr e m => e -> m a
throwErr (forall e. FromHsCiError e => HsCiError -> e
fromHsCiError HsCiError
err)
    Right ([Sh] -> [Sh]
g, ()) -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Sh] -> [Sh]
g [])

liftSh :: Sh -> ShM ()
liftSh :: Sh -> ShM ()
liftSh Sh
s = forall a.
(([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
ShM forall a b. (a -> b) -> a -> b
$ \[Sh] -> [Sh]
shs -> forall a b. b -> Either a b
Right ([Sh] -> [Sh]
shs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sh
s forall a. a -> [a] -> [a]
:), ())

instance Applicative ShM where
    pure :: forall a. a -> ShM a
pure a
x = forall a.
(([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
ShM forall a b. (a -> b) -> a -> b
$ \[Sh] -> [Sh]
shs -> forall a b. b -> Either a b
Right ([Sh] -> [Sh]
shs, a
x)
    <*> :: forall a b. ShM (a -> b) -> ShM a -> ShM b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad ShM where
    return :: forall a. a -> ShM a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure

    ShM a
m >>= :: forall a b. ShM a -> (a -> ShM b) -> ShM b
>>= a -> ShM b
k = forall a.
(([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
ShM forall a b. (a -> b) -> a -> b
$ \[Sh] -> [Sh]
shs0 -> do
        ([Sh] -> [Sh]
shs1, a
x) <- forall a.
ShM a -> ([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)
unShM ShM a
m     [Sh] -> [Sh]
shs0
        ([Sh] -> [Sh]
shs2, b
y) <- forall a.
ShM a -> ([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)
unShM (a -> ShM b
k a
x) [Sh] -> [Sh]
shs1
        forall (m :: * -> *) a. Monad m => a -> m a
return ([Sh] -> [Sh]
shs2, b
y)

instance MonadErr HsCiError ShM where
    throwErr :: forall a. HsCiError -> ShM a
throwErr HsCiError
err = forall a.
(([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
ShM forall a b. (a -> b) -> a -> b
$ \[Sh] -> [Sh]
_ -> forall a b. a -> Either a b
Left HsCiError
err

unsafeSh :: String -> ShM ()
unsafeSh :: String -> ShM ()
unsafeSh String
x = forall a.
(([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
ShM forall a b. (a -> b) -> a -> b
$ \[Sh] -> [Sh]
shs -> forall a b. b -> Either a b
Right ([Sh] -> [Sh]
shs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Sh
Sh String
x forall a. a -> [a] -> [a]
:),      ())

instance MonadSh ShM where
#ifndef MIN_VERSION_ShellCheck
    sh' _ = unsafeSh
#else
    sh' :: [Integer] -> String -> ShM ()
sh' [Integer]
excl String
cmd
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CheckResult -> [PositionedComment]
SC.crComments CheckResult
res) = String -> ShM ()
unsafeSh String
cmd
        | Bool
otherwise                = forall e (m :: * -> *) a. MonadErr e m => e -> m a
throwErr forall a b. (a -> b) -> a -> b
$ String -> HsCiError
ShellCheckError forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$
            (String
"ShellCheck! " forall a. [a] -> [a] -> [a]
++ String
cmd) forall a. a -> [a] -> [a]
:
            [ String
"SC" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (Comment -> Integer
SC.cCode Comment
c) forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ Comment -> String
SC.cMessage Comment
c
            | PositionedComment
pc <- CheckResult -> [PositionedComment]
SC.crComments CheckResult
res
            , let c :: Comment
c = PositionedComment -> Comment
SC.pcComment PositionedComment
pc
            ]
      where
        res :: CheckResult
res = forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
SystemInterface m -> CheckSpec -> m CheckResult
checkScript SystemInterface Identity
iface CheckSpec
spec
        iface :: SystemInterface Identity
iface = [(String, String)] -> SystemInterface Identity
SC.mockedSystemInterface []
        spec :: CheckSpec
spec  = CheckSpec
SC.emptyCheckSpec
            { csFilename :: String
SC.csFilename          = String
"stdin"
            , csScript :: String
SC.csScript            = String
cmd
            , csExcludedWarnings :: [Integer]
SC.csExcludedWarnings  = [Integer]
excl
            , csShellTypeOverride :: Maybe Shell
SC.csShellTypeOverride = forall a. a -> Maybe a
Just Shell
SC.Sh
            }
#endif
    comment :: String -> ShM ()
comment String
x = forall a.
(([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
ShM forall a b. (a -> b) -> a -> b
$ \[Sh] -> [Sh]
shs -> forall a b. b -> Either a b
Right ([Sh] -> [Sh]
shs forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Sh
Comment String
x forall a. a -> [a] -> [a]
:), ())

    commentedBlock :: String -> ShM () -> ShM ()
commentedBlock String
c ShM ()
m = case forall e (m :: * -> *).
(MonadErr e m, FromHsCiError e) =>
ShM () -> m [Sh]
runSh ShM ()
m of
        Left HsCiError
err  -> forall e (m :: * -> *) a. MonadErr e m => e -> m a
throwErr HsCiError
err
        Right [Sh]
shs
            | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Sh -> Bool
isComment [Sh]
shs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            | Bool
otherwise         -> forall a.
(([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
ShM forall a b. (a -> b) -> a -> b
$ \[Sh] -> [Sh]
shs1 -> forall a b. b -> Either a b
Right
                ([Sh] -> [Sh]
shs1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Sh]
shs2 -> String -> Sh
Comment String
c forall a. a -> [a] -> [a]
: [Sh]
shs forall a. [a] -> [a] -> [a]
++ [Sh]
shs2), ())