module Podman
  ( -- * Main data types
    ContainerState (..),
    Container (..),

    -- * Convenient functions
    inspectContainer,
    isContainer,
  )
where

import Data.Aeson (FromJSON, decode, genericParseJSON, parseJSON)
import Data.Aeson.Casing (aesonPrefix, pascalCase)
import Data.ByteString.Lazy.Char8 (pack)
import Data.Maybe (fromMaybe, isJust)
import Data.Text (Text)
import GHC.Generics (Generic)
import SimpleCmd (cmd, cmdMaybe, cmd_)

data ContainerState
  = ContainerState
      { ContainerState -> Bool
containerRunning :: Bool,
        ContainerState -> Text
containerStatus :: Text
      }
  deriving stock (Int -> ContainerState -> ShowS
[ContainerState] -> ShowS
ContainerState -> String
(Int -> ContainerState -> ShowS)
-> (ContainerState -> String)
-> ([ContainerState] -> ShowS)
-> Show ContainerState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContainerState] -> ShowS
$cshowList :: [ContainerState] -> ShowS
show :: ContainerState -> String
$cshow :: ContainerState -> String
showsPrec :: Int -> ContainerState -> ShowS
$cshowsPrec :: Int -> ContainerState -> ShowS
Show, (forall x. ContainerState -> Rep ContainerState x)
-> (forall x. Rep ContainerState x -> ContainerState)
-> Generic ContainerState
forall x. Rep ContainerState x -> ContainerState
forall x. ContainerState -> Rep ContainerState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContainerState x -> ContainerState
$cfrom :: forall x. ContainerState -> Rep ContainerState x
Generic)

instance FromJSON ContainerState where
  -- this custom decoder takes care of setting 'Status' to the `containerStatus` attribute
  -- because attribute name can't start with an uppercase, we can't use DeriveAnyClass
  parseJSON :: Value -> Parser ContainerState
parseJSON = Options -> Value -> Parser ContainerState
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ContainerState)
-> Options -> Value -> Parser ContainerState
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
pascalCase

data Container
  = Container
      { Container -> Text
containerId :: Text,
        Container -> ContainerState
containerState :: ContainerState
      }
  deriving stock (Int -> Container -> ShowS
[Container] -> ShowS
Container -> String
(Int -> Container -> ShowS)
-> (Container -> String)
-> ([Container] -> ShowS)
-> Show Container
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Container] -> ShowS
$cshowList :: [Container] -> ShowS
show :: Container -> String
$cshow :: Container -> String
showsPrec :: Int -> Container -> ShowS
$cshowsPrec :: Int -> Container -> ShowS
Show, (forall x. Container -> Rep Container x)
-> (forall x. Rep Container x -> Container) -> Generic Container
forall x. Rep Container x -> Container
forall x. Container -> Rep Container x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Container x -> Container
$cfrom :: forall x. Container -> Rep Container x
Generic)

instance FromJSON Container where
  parseJSON :: Value -> Parser Container
parseJSON = Options -> Value -> Parser Container
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Container)
-> Options -> Value -> Parser Container
forall a b. (a -> b) -> a -> b
$ ShowS -> Options
aesonPrefix ShowS
pascalCase

-- | Read a container status
inspectContainer ::
  -- | The container name
  String ->
  -- | Returns the container status
  IO (Maybe Container)
inspectContainer :: String -> IO (Maybe Container)
inspectContainer name :: String
name = do
  ByteString
podInspect <- String -> ByteString
pack (String -> ByteString)
-> (Maybe String -> String) -> Maybe String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe String -> ByteString) -> IO (Maybe String) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO (Maybe String)
cmdMaybe "podman" ["container", "inspect", String
name]
  Maybe Container -> IO (Maybe Container)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Container -> IO (Maybe Container))
-> Maybe Container -> IO (Maybe Container)
forall a b. (a -> b) -> a -> b
$ case ByteString -> Maybe [Container]
forall a. FromJSON a => ByteString -> Maybe a
decode ByteString
podInspect of
    Just [container :: Container
container] -> Container -> Maybe Container
forall a. a -> Maybe a
Just Container
container
    _ -> Maybe Container
forall a. Maybe a
Nothing

-- | Check if a container exists
isContainer ::
  -- | The container name
  String ->
  -- | Returns True is the container exists
  IO Bool
isContainer :: String -> IO Bool
isContainer name :: String
name = Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO (Maybe String)
cmdMaybe "podman" ["container", "exists", String
name]