Actions.hs

{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE OverloadedStrings #-}

module System.Handsy.Actions where

import           Control.Applicative
import           Control.Concurrent
import           Control.Error
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
import qualified Data.ByteString.Char8      as B8
import qualified Data.ByteString.Lazy       as BL
import qualified Data.ByteString.Lazy.Char8 as BL8
import           Data.Default.Class
import           Data.List.Split
import           Prelude                    hiding (appendFile, readFile,
                                             writeFile)
import           System.Exit
import           System.Handsy.Internal
import           Text.ShellEscape

-- | Runs a command
command :: FilePath     -- ^ Command to run
        -> [String]     -- ^ Arguments
        -> CommandOptions
        -> Handsy (ExitCode, BL.ByteString, BL.ByteString) -- ^ (status, stdout, stderr)
command cmd args opts = let cmd' = B8.unpack . B8.intercalate " " . map (bytes . bash . B8.pack) $ (cmd:args)
                        in  shell cmd' opts

{-| Executes the given string in shell. Example:

  > shell "ls" $~ def{cwd="/var/www"}
-}
shell :: String       -- ^ String to execute
      -> CommandOptions
      -> Handsy (ExitCode, BL.ByteString, BL.ByteString) -- ^ (ExitCode, Stdout, Stderr)
shell cmd opts = let esc = B8.unpack . bytes . bash . B8.pack
                     CommandOptions stdin' cwd' = opts
                 in  shellF ((if null cwd' then "" else ("cd " ++ esc cwd' ++ "; ")) ++ cmd) stdin'

data CommandOptions =
  CommandOptions { stdin :: BL.ByteString
                 , cwd   :: String
                 }

instance Default CommandOptions where
  def = CommandOptions "" ""

-- | Reads a file and returns the contents of the file.
readFile :: FilePath -> Handsy BL.ByteString
readFile fp = command "cat" [fp] def >>= \case
  (ExitSuccess, sout, _) -> return sout
  (_, _, serr)           -> lift . left $ "Serror reading " ++ fp ++ "\nSerr was: " ++ BL8.unpack serr

-- | @writeFile file str@ function writes the bytestring @str@, to the file @file@.
writeFile :: FilePath -> BL.ByteString -> Handsy ()
writeFile fp s = command "dd" ["of=" ++ fp] def{stdin=s} >>= \case
  (ExitSuccess, _, _) -> return ()
  (_, _, serr)      -> lift . left $ "Serror writing to " ++ fp  ++ "\nSerr was: " ++ BL8.unpack serr

-- | @appendFile file str@ function appends the bytestring @str@, to the file @file@.
appendFile :: FilePath -> BL.ByteString -> Handsy ()
appendFile fp s = command "dd" ["of=" ++ fp, "conv=notrunc", "oflag=append"] def{stdin=s} >>= \case
  (ExitSuccess, _, _) -> return ()
  (_, _, serr)      -> lift . left $ "Serror appending to " ++ fp ++ "\nSerr was: " ++ BL8.unpack serr

-- | Same as 'command', but ExitFailure ends the computation.
command_ :: FilePath -> [String] -> CommandOptions -> Handsy (BL.ByteString, BL.ByteString)
command_ path args opts = command path args opts >>= \case
  (ExitFailure code, _, serr) -> lift $ left ('`':path ++ ' ' : show args ++ "` returned " ++ show code
                                                ++ "\nSerr was: " ++ BL8.unpack serr)
  (ExitSuccess, sout, serr) -> return (sout, serr)

-- | Same as 'shell', but ExitFailure ends the computation.
shell_ :: String -> CommandOptions -> Handsy (BL.ByteString, BL.ByteString)
shell_ cmd opts = shell cmd opts >>= \case
  (ExitFailure code, _, serr) -> lift $ left ('`':cmd ++ "` returned " ++ show code
                                                ++ "\nSerr was: " ++ BL8.unpack serr)
  (ExitSuccess, sout, serr) -> return (sout, serr)

-- * Helpers for parsing return values of 'command' and 'shell'

class IsReturnValue a where
  stdout   :: a -> BL.ByteString
  stderr   :: a -> BL.ByteString
  exitCode :: a -> ExitCode

instance IsReturnValue (BL.ByteString, BL.ByteString) where
  stdout   = fst
  stderr   = snd
  exitCode = const ExitSuccess

instance IsReturnValue (ExitCode, BL.ByteString, BL.ByteString) where
  stdout   = \case (_, a, _) -> a
  stderr   = \case (_, _, a) -> a
  exitCode = \case (a, _, _) -> a

isSuccessful :: IsReturnValue a => a -> Bool
isSuccessful = isExitSuccess . exitCode

isExitSuccess :: ExitCode -> Bool
isExitSuccess = \case
  ExitSuccess   -> True
  ExitFailure _ -> False

-- | Extract lines from a ByteString. Useful for parsing unix commands.
strLines :: BL.ByteString -> [String]
strLines = lines . BL8.unpack

-- | Waits specified number of seconds
sleep :: Int -> Handsy ()
sleep = liftIO . threadDelay . (* 1000000)

-- | Creates a temporary file
mkTemp :: String -> Handsy String
mkTemp suffix = do
  out <- strLines .stdout <$> command_ "mktemp" (bool ["--suffix=" ++ suffix] [] (null suffix)) def
  lift $ tryHead ("weird output from mktemp: " ++ show out) out

-- | Creates a temporary directory
mkTempDir :: String -> Handsy String
mkTempDir suffix
  = command_ "mktemp" ("-d" : bool ["--suffix" ++ suffix] [] (null suffix)) def
    >>= lift . tryHead "weird output from mktemp" . strLines . stdout

-- | Returns if the specified process is running. Uses `pidof`
isRunning :: String -> Handsy Bool
isRunning p = isSuccessful <$> command "pidof" ["-s", "-x", p] def

data OS = NixOS | Debian | Ubuntu | RHEL | CentOS | Fedora | ArchLinux
  deriving (Show, Eq)

{-| Guesses the os using `/etc/os-release`. This currently only supports Linux distributions
    abiding systemd standards. -}
os :: Handsy (Maybe OS)
os = parseOsRelease <$> readFile "/etc/os-release" >>= return . \case
    Just "ubuntu" -> Just Ubuntu
    Just "debian" -> Just Debian
    Just "nixos"  -> Just NixOS
    Just "rhel"   -> Just RHEL
    Just "centos" -> Just CentOS
    Just "fedora" -> Just Fedora
    Just "arch"   -> Just ArchLinux
    _             -> Nothing
  where parseOsRelease = fmap (filter $ not . flip elem ['\'', '"']) -- Hack to unquote
          <$> lookup "ID" . map ((\(x:xs) -> (x, concat xs)) . splitOn "=") . strLines