module Cloudy.Cmd.Utils where

import Cloudy.Db (CloudyInstanceId, OnlyOne (..), InstanceInfo, findCloudyInstanceIdByName, findOnlyOneInstanceId, instanceInfoForId)
import Data.Text (Text, unpack)
import Database.SQLite.Simple (Connection)

data SelectInstBy = SelectInstByName Text | SelectInstById CloudyInstanceId | SelectInstOnlyOne
  deriving stock Int -> SelectInstBy -> ShowS
[SelectInstBy] -> ShowS
SelectInstBy -> [Char]
(Int -> SelectInstBy -> ShowS)
-> (SelectInstBy -> [Char])
-> ([SelectInstBy] -> ShowS)
-> Show SelectInstBy
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectInstBy -> ShowS
showsPrec :: Int -> SelectInstBy -> ShowS
$cshow :: SelectInstBy -> [Char]
show :: SelectInstBy -> [Char]
$cshowList :: [SelectInstBy] -> ShowS
showList :: [SelectInstBy] -> ShowS
Show

mkSelectInstBy :: Maybe CloudyInstanceId -> Maybe Text -> IO SelectInstBy
mkSelectInstBy :: Maybe CloudyInstanceId -> Maybe Text -> IO SelectInstBy
mkSelectInstBy Maybe CloudyInstanceId
maybeCloudyInstId Maybe Text
maybeCloudyInstName =
  case (Maybe CloudyInstanceId
maybeCloudyInstId, Maybe Text
maybeCloudyInstName) of
    (Just CloudyInstanceId
cloudyInstanceId, Maybe Text
Nothing) -> SelectInstBy -> IO SelectInstBy
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SelectInstBy -> IO SelectInstBy)
-> SelectInstBy -> IO SelectInstBy
forall a b. (a -> b) -> a -> b
$ CloudyInstanceId -> SelectInstBy
SelectInstById CloudyInstanceId
cloudyInstanceId
    (Maybe CloudyInstanceId
Nothing, Just Text
cloudyInstanceName) -> SelectInstBy -> IO SelectInstBy
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SelectInstBy -> IO SelectInstBy)
-> SelectInstBy -> IO SelectInstBy
forall a b. (a -> b) -> a -> b
$ Text -> SelectInstBy
SelectInstByName Text
cloudyInstanceName
    (Maybe CloudyInstanceId
Nothing, Maybe Text
Nothing) -> SelectInstBy -> IO SelectInstBy
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SelectInstBy
SelectInstOnlyOne
    (Maybe CloudyInstanceId
_, Maybe Text
_) -> [Char] -> IO SelectInstBy
forall a. HasCallStack => [Char] -> a
error [Char]
"Both cloudy instance id and cloudy instance name were specified.  You can only specify at most one of these."

findCloudyInstanceIdForSelectInstBy :: Connection -> SelectInstBy -> IO CloudyInstanceId
findCloudyInstanceIdForSelectInstBy :: Connection -> SelectInstBy -> IO CloudyInstanceId
findCloudyInstanceIdForSelectInstBy Connection
conn = \case
  SelectInstByName Text
instName -> do
    Maybe CloudyInstanceId
maybeCloudyInstId <- Connection -> Text -> IO (Maybe CloudyInstanceId)
findCloudyInstanceIdByName Connection
conn Text
instName
    case Maybe CloudyInstanceId
maybeCloudyInstId of
      Maybe CloudyInstanceId
Nothing ->
        [Char] -> IO CloudyInstanceId
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO CloudyInstanceId)
-> (Text -> [Char]) -> Text -> IO CloudyInstanceId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
unpack (Text -> IO CloudyInstanceId) -> Text -> IO CloudyInstanceId
forall a b. (a -> b) -> a -> b
$
          Text
"No cloudy instances found with name \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
instName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
      Just CloudyInstanceId
cloudyInstId -> CloudyInstanceId -> IO CloudyInstanceId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CloudyInstanceId
cloudyInstId
  SelectInstById CloudyInstanceId
cloudyInstanceId -> CloudyInstanceId -> IO CloudyInstanceId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CloudyInstanceId
cloudyInstanceId
  SelectInstBy
SelectInstOnlyOne -> do
    OnlyOne CloudyInstanceId
onlyOneInstId <- Connection -> IO (OnlyOne CloudyInstanceId)
findOnlyOneInstanceId Connection
conn
    case OnlyOne CloudyInstanceId
onlyOneInstId of
      OnlyOne CloudyInstanceId
instId -> CloudyInstanceId -> IO CloudyInstanceId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CloudyInstanceId
instId
      OnlyOne CloudyInstanceId
MultipleExist ->
        [Char] -> IO CloudyInstanceId
forall a. HasCallStack => [Char] -> a
error
          [Char]
"Multiple cloudy instances exist in the database, so you must pass \
          \--id or --name to operate on a specific instance."
      OnlyOne CloudyInstanceId
NoneExist ->
        [Char] -> IO CloudyInstanceId
forall a. HasCallStack => [Char] -> a
error [Char]
"No cloudy instances exist in the database"

findInstanceInfoForSelectInstBy :: Connection -> SelectInstBy -> IO InstanceInfo
findInstanceInfoForSelectInstBy :: Connection -> SelectInstBy -> IO InstanceInfo
findInstanceInfoForSelectInstBy Connection
conn SelectInstBy
selectInstBy = do
  CloudyInstanceId
cloudyInstanceId <- Connection -> SelectInstBy -> IO CloudyInstanceId
findCloudyInstanceIdForSelectInstBy Connection
conn SelectInstBy
selectInstBy
  Maybe InstanceInfo
maybeInstInfo <- Connection -> CloudyInstanceId -> IO (Maybe InstanceInfo)
instanceInfoForId Connection
conn CloudyInstanceId
cloudyInstanceId
  case Maybe InstanceInfo
maybeInstInfo of
    Maybe InstanceInfo
Nothing -> [Char] -> IO InstanceInfo
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO InstanceInfo) -> [Char] -> IO InstanceInfo
forall a b. (a -> b) -> a -> b
$ [Char]
"Couldn't find instance info for selection: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> SelectInstBy -> [Char]
forall a. Show a => a -> [Char]
show SelectInstBy
selectInstBy
    Just InstanceInfo
instInfo -> InstanceInfo -> IO InstanceInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure InstanceInfo
instInfo