{-# LANGUAGE OverloadedStrings #-}

module Keter.SharedData.AppManager
    ( Action(..)
    , AppState(..)
    , showAppState
    ) where

import Control.Concurrent.STM (STM, TVar, readTVar)
import Data.Foldable (fold)
import Data.Text (Text, pack, unpack)
import Keter.Config (AppInput)
import Keter.SharedData.App (App, showApp)
import System.Posix.Types (EpochTime)
import Text.Printf (printf)

data Action = Reload AppInput | Terminate
 deriving Int -> Action -> String -> String
[Action] -> String -> String
Action -> String
(Int -> Action -> String -> String)
-> (Action -> String)
-> ([Action] -> String -> String)
-> Show Action
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Action -> String -> String
showsPrec :: Int -> Action -> String -> String
$cshow :: Action -> String
show :: Action -> String
$cshowList :: [Action] -> String -> String
showList :: [Action] -> String -> String
Show

data AppState = ASRunning App
              | ASStarting
                    !(Maybe App)
                    !(TVar (Maybe EpochTime))
                    !(TVar (Maybe Action)) -- ^ the next one to try
              | ASTerminated

showAppState :: AppState -> STM Text
showAppState :: AppState -> STM Text
showAppState (ASRunning App
x) = (\Text
x' -> Text
"running(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") (Text -> Text) -> STM Text -> STM Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> App -> STM Text
showApp App
x
showAppState (ASStarting Maybe App
mapp TVar (Maybe EpochTime)
tmtime TVar (Maybe Action)
tmaction) = do
  Maybe EpochTime
mtime   <- TVar (Maybe EpochTime) -> STM (Maybe EpochTime)
forall a. TVar a -> STM a
readTVar TVar (Maybe EpochTime)
tmtime
  Maybe Action
maction <- TVar (Maybe Action) -> STM (Maybe Action)
forall a. TVar a -> STM a
readTVar TVar (Maybe Action)
tmaction
  Maybe Text
mtext <- (App -> STM Text) -> Maybe App -> STM (Maybe Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse App -> STM Text
showApp Maybe App
mapp
  Text -> STM Text
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> STM Text) -> Text -> STM Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"starting app %s, time %s, action %s \n" (Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe Text
mtext) (Maybe EpochTime -> String
forall a. Show a => a -> String
show Maybe EpochTime
mtime) (Maybe Action -> String
forall a. Show a => a -> String
show Maybe Action
maction)
showAppState AppState
ASTerminated = Text -> STM Text
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"terminated"