{-# LANGUAGE OverloadedRecordDot #-}

module Cloudy.Cmd.List where

import Cloudy.Cli (ListCliOpts (..))
import Cloudy.Db (CloudyInstance (..), InstanceInfo (..), ScalewayInstance (..), cloudyInstanceFromInstanceInfo, findAllInstanceInfos, withCloudyDb, unCloudyInstanceId)
import Cloudy.InstanceSetup.Types (InstanceSetup (..))
import Cloudy.LocalConfFile (LocalConfFileOpts)
import Cloudy.Table (Table (..), printTable, Align (..))
import Data.List (sortOn)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Text (Text, pack)
import Data.Time (defaultTimeLocale, formatTime, UTCTime, utcToZonedTime, TimeZone, getCurrentTimeZone)
import Data.Void (absurd)

runList :: LocalConfFileOpts -> ListCliOpts -> IO ()
runList :: LocalConfFileOpts -> ListCliOpts -> IO ()
runList LocalConfFileOpts
_localConfFileOpts ListCliOpts
_opts = do
  [InstanceInfo]
instInfos <- (Connection -> IO [InstanceInfo]) -> IO [InstanceInfo]
forall a. (Connection -> IO a) -> IO a
withCloudyDb ((Connection -> IO [InstanceInfo]) -> IO [InstanceInfo])
-> (Connection -> IO [InstanceInfo]) -> IO [InstanceInfo]
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> Connection -> IO [InstanceInfo]
findAllInstanceInfos Connection
conn
  [InstanceInfo] -> IO ()
displayInstanceInfos [InstanceInfo]
instInfos

displayInstanceInfos :: [InstanceInfo] -> IO ()
displayInstanceInfos :: [InstanceInfo] -> IO ()
displayInstanceInfos [InstanceInfo]
instInfos = do
  TimeZone
tz <- IO TimeZone
getCurrentTimeZone
  let sortByCloudyInstId :: [InstanceInfo]
sortByCloudyInstId = (InstanceInfo -> CloudyInstanceId)
-> [InstanceInfo] -> [InstanceInfo]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\InstanceInfo
instInfo -> (InstanceInfo -> CloudyInstance
cloudyInstanceFromInstanceInfo InstanceInfo
instInfo).id) [InstanceInfo]
instInfos
  case [InstanceInfo]
sortByCloudyInstId of
    [] -> String -> IO ()
putStrLn String
"No instances currently running."
    (InstanceInfo
hInst : [InstanceInfo]
tInsts) -> do
      let instTable :: Table
instTable = TimeZone -> NonEmpty InstanceInfo -> Table
mkTable TimeZone
tz (InstanceInfo
hInst InstanceInfo -> [InstanceInfo] -> NonEmpty InstanceInfo
forall a. a -> [a] -> NonEmpty a
:| [InstanceInfo]
tInsts)
      Table -> IO ()
printTable Table
instTable

mkTable :: TimeZone -> NonEmpty InstanceInfo -> Table
mkTable :: TimeZone -> NonEmpty InstanceInfo -> Table
mkTable TimeZone
tz NonEmpty InstanceInfo
instanceTypes =
  Table
    { $sel:tableHeaders:Table :: NonEmpty (Align, Text)
tableHeaders =
        (Align
RightJustified, Text
"instance id") (Align, Text) -> [(Align, Text)] -> NonEmpty (Align, Text)
forall a. a -> [a] -> NonEmpty a
:|
        [ (Align
LeftJustified, Text
"instance name")
        , (Align
LeftJustified, Text
"created date")
        , (Align
LeftJustified, Text
"cloud")
        , (Align
LeftJustified, Text
"zone")
        , (Align
LeftJustified, Text
"ip")
        , (Align
LeftJustified, Text
"instance setup")
        ]
    , $sel:tableBodyRows:Table :: NonEmpty (NonEmpty Text)
tableBodyRows = (InstanceInfo -> NonEmpty Text)
-> NonEmpty InstanceInfo -> NonEmpty (NonEmpty Text)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TimeZone -> InstanceInfo -> NonEmpty Text
mkRow TimeZone
tz) NonEmpty InstanceInfo
instanceTypes
    }

mkRow :: TimeZone -> InstanceInfo -> NonEmpty Text
mkRow :: TimeZone -> InstanceInfo -> NonEmpty Text
mkRow TimeZone
tz = \case
  CloudyAwsInstance CloudyInstance
_ Void
void -> Void -> NonEmpty Text
forall a. Void -> a
absurd Void
void
  CloudyScalewayInstance CloudyInstance
cloudyInstance ScalewayInstance
scalewayInstance ->
    String -> Text
pack (Int64 -> String
forall a. Show a => a -> String
show (CloudyInstanceId -> Int64
unCloudyInstanceId CloudyInstance
cloudyInstance.id)) Text -> [Text] -> NonEmpty Text
forall a. a -> [a] -> NonEmpty a
:|
    [ CloudyInstance
cloudyInstance.name
    , Maybe UTCTime -> Text
formatDateTime CloudyInstance
cloudyInstance.createdAt
    , Text
"scaleway"
    , ScalewayInstance
scalewayInstance.scalewayZone
    , ScalewayInstance
scalewayInstance.scalewayIpAddress
    , Maybe InstanceSetup -> Text
prettyInstanceSetup CloudyInstance
cloudyInstance.instanceSetup
    ]
  where
    formatDateTime :: Maybe UTCTime -> Text
    formatDateTime :: Maybe UTCTime -> Text
formatDateTime = \case
      Maybe UTCTime
Nothing -> Text
"ERROR: expecting cloudy instance to have created_at value"
      Just UTCTime
createdAt ->
        String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%Y-%m-%d %H:%M" (ZonedTime -> String) -> ZonedTime -> String
forall a b. (a -> b) -> a -> b
$ TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
tz UTCTime
createdAt

    prettyInstanceSetup :: Maybe InstanceSetup -> Text
    prettyInstanceSetup :: Maybe InstanceSetup -> Text
prettyInstanceSetup = \case
      Maybe InstanceSetup
Nothing -> Text
"(none)"
      Just InstanceSetup
instSetup -> InstanceSetup
instSetup.name