{-# 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
(Int -> Sh -> ShowS)
-> (Sh -> String) -> ([Sh] -> ShowS) -> Show Sh
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sh -> ShowS
showsPrec :: Int -> Sh -> ShowS
$cshow :: Sh -> String
show :: Sh -> String
$cshowList :: [Sh] -> ShowS
showList :: [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
"# " String -> ShowS
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 ((Sh -> String) -> [Sh] -> [String]
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 = [Integer] -> String -> m ()
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 -> b) -> ShM a -> ShM b)
-> (forall a b. a -> ShM b -> ShM a) -> Functor ShM
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
$cfmap :: forall a b. (a -> b) -> ShM a -> ShM b
fmap :: forall a b. (a -> b) -> ShM a -> ShM b
$c<$ :: forall a b. a -> ShM b -> ShM a
<$ :: forall a b. a -> ShM b -> ShM a
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 [Sh] -> [Sh]
forall a. a -> a
id of
    Left HsCiError
err      -> e -> m [Sh]
forall a. e -> m a
forall e (m :: * -> *) a. MonadErr e m => e -> m a
throwErr (HsCiError -> e
forall e. FromHsCiError e => HsCiError -> e
fromHsCiError HsCiError
err)
    Right ([Sh] -> [Sh]
g, ()) -> [Sh] -> m [Sh]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Sh] -> [Sh]
g [])

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

instance Applicative ShM where
    pure :: forall a. a -> ShM a
pure a
x = (([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
forall a.
(([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
ShM ((([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a)
-> (([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
forall a b. (a -> b) -> a -> b
$ \[Sh] -> [Sh]
shs -> ([Sh] -> [Sh], a) -> Either HsCiError ([Sh] -> [Sh], a)
forall a b. b -> Either a b
Right ([Sh] -> [Sh]
shs, a
x)
    <*> :: forall a b. ShM (a -> b) -> ShM a -> ShM 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 = a -> ShM a
forall a. a -> ShM a
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 = (([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], b)) -> ShM b
forall a.
(([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
ShM ((([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], b)) -> ShM b)
-> (([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], b)) -> ShM b
forall a b. (a -> b) -> a -> b
$ \[Sh] -> [Sh]
shs0 -> do
        ([Sh] -> [Sh]
shs1, a
x) <- ShM a -> ([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)
forall a.
ShM a -> ([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)
unShM ShM a
m     [Sh] -> [Sh]
shs0
        ([Sh] -> [Sh]
shs2, b
y) <- ShM b -> ([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], b)
forall a.
ShM a -> ([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)
unShM (a -> ShM b
k a
x) [Sh] -> [Sh]
shs1
        ([Sh] -> [Sh], b) -> Either HsCiError ([Sh] -> [Sh], b)
forall a. a -> Either HsCiError a
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 = (([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
forall a.
(([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
ShM ((([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a)
-> (([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
forall a b. (a -> b) -> a -> b
$ \[Sh] -> [Sh]
_ -> HsCiError -> Either HsCiError ([Sh] -> [Sh], a)
forall a b. a -> Either a b
Left HsCiError
err

unsafeSh :: String -> ShM ()
unsafeSh :: String -> ShM ()
unsafeSh String
x = (([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], ())) -> ShM ()
forall a.
(([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
ShM ((([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], ())) -> ShM ())
-> (([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], ()))
-> ShM ()
forall a b. (a -> b) -> a -> b
$ \[Sh] -> [Sh]
shs -> ([Sh] -> [Sh], ()) -> Either HsCiError ([Sh] -> [Sh], ())
forall a b. b -> Either a b
Right ([Sh] -> [Sh]
shs ([Sh] -> [Sh]) -> ([Sh] -> [Sh]) -> [Sh] -> [Sh]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Sh
Sh String
x Sh -> [Sh] -> [Sh]
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
        | [PositionedComment] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (CheckResult -> [PositionedComment]
SC.crComments CheckResult
res) = String -> ShM ()
unsafeSh String
cmd
        | Bool
otherwise                = HsCiError -> ShM ()
forall a. HsCiError -> ShM a
forall e (m :: * -> *) a. MonadErr e m => e -> m a
throwErr (HsCiError -> ShM ()) -> HsCiError -> ShM ()
forall a b. (a -> b) -> a -> b
$ String -> HsCiError
ShellCheckError (String -> HsCiError) -> String -> HsCiError
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
            (String
"ShellCheck! " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cmd) String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
            [ String
"SC" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Comment -> Integer
SC.cCode Comment
c) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
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 = Identity CheckResult -> CheckResult
forall a. Identity a -> a
runIdentity (Identity CheckResult -> CheckResult)
-> Identity CheckResult -> CheckResult
forall a b. (a -> b) -> a -> b
$ SystemInterface Identity -> CheckSpec -> Identity CheckResult
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
            { SC.csFilename          = "stdin"
            , SC.csScript            = cmd
            , SC.csExcludedWarnings  = excl
            , SC.csShellTypeOverride = Just SC.Sh
            }
#endif
    comment :: String -> ShM ()
comment String
x = (([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], ())) -> ShM ()
forall a.
(([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], a)) -> ShM a
ShM ((([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], ())) -> ShM ())
-> (([Sh] -> [Sh]) -> Either HsCiError ([Sh] -> [Sh], ()))
-> ShM ()
forall a b. (a -> b) -> a -> b
$ \[Sh] -> [Sh]
shs -> ([Sh] -> [Sh], ()) -> Either HsCiError ([Sh] -> [Sh], ())
forall a b. b -> Either a b
Right ([Sh] -> [Sh]
shs ([Sh] -> [Sh]) -> ([Sh] -> [Sh]) -> [Sh] -> [Sh]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Sh
Comment String
x Sh -> [Sh] -> [Sh]
forall a. a -> [a] -> [a]
:), ())

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