{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE LambdaCase #-}

module Data.ApplicationState
  ( ApplicationState(..)
  , stateOf
  ) where

import Control.Concurrent.Async (Async, poll)
import Control.Exception (SomeException)
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)

-- | The state of a running Haskell application
-- or an running 'Async' action
data ApplicationState
  = Running -- ^ Application (action) is running
  | Finished String -- ^ Result of the async action
  | Error String -- ^ Description of the error (exception)
  deriving (ReadPrec [ApplicationState]
ReadPrec ApplicationState
Int -> ReadS ApplicationState
ReadS [ApplicationState]
(Int -> ReadS ApplicationState)
-> ReadS [ApplicationState]
-> ReadPrec ApplicationState
-> ReadPrec [ApplicationState]
-> Read ApplicationState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplicationState]
$creadListPrec :: ReadPrec [ApplicationState]
readPrec :: ReadPrec ApplicationState
$creadPrec :: ReadPrec ApplicationState
readList :: ReadS [ApplicationState]
$creadList :: ReadS [ApplicationState]
readsPrec :: Int -> ReadS ApplicationState
$creadsPrec :: Int -> ReadS ApplicationState
Read, Int -> ApplicationState -> ShowS
[ApplicationState] -> ShowS
ApplicationState -> String
(Int -> ApplicationState -> ShowS)
-> (ApplicationState -> String)
-> ([ApplicationState] -> ShowS)
-> Show ApplicationState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplicationState] -> ShowS
$cshowList :: [ApplicationState] -> ShowS
show :: ApplicationState -> String
$cshow :: ApplicationState -> String
showsPrec :: Int -> ApplicationState -> ShowS
$cshowsPrec :: Int -> ApplicationState -> ShowS
Show, ApplicationState -> ApplicationState -> Bool
(ApplicationState -> ApplicationState -> Bool)
-> (ApplicationState -> ApplicationState -> Bool)
-> Eq ApplicationState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplicationState -> ApplicationState -> Bool
$c/= :: ApplicationState -> ApplicationState -> Bool
== :: ApplicationState -> ApplicationState -> Bool
$c== :: ApplicationState -> ApplicationState -> Bool
Eq, (forall x. ApplicationState -> Rep ApplicationState x)
-> (forall x. Rep ApplicationState x -> ApplicationState)
-> Generic ApplicationState
forall x. Rep ApplicationState x -> ApplicationState
forall x. ApplicationState -> Rep ApplicationState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ApplicationState x -> ApplicationState
$cfrom :: forall x. ApplicationState -> Rep ApplicationState x
Generic, [ApplicationState] -> Encoding
[ApplicationState] -> Value
ApplicationState -> Encoding
ApplicationState -> Value
(ApplicationState -> Value)
-> (ApplicationState -> Encoding)
-> ([ApplicationState] -> Value)
-> ([ApplicationState] -> Encoding)
-> ToJSON ApplicationState
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ApplicationState] -> Encoding
$ctoEncodingList :: [ApplicationState] -> Encoding
toJSONList :: [ApplicationState] -> Value
$ctoJSONList :: [ApplicationState] -> Value
toEncoding :: ApplicationState -> Encoding
$ctoEncoding :: ApplicationState -> Encoding
toJSON :: ApplicationState -> Value
$ctoJSON :: ApplicationState -> Value
ToJSON, Value -> Parser [ApplicationState]
Value -> Parser ApplicationState
(Value -> Parser ApplicationState)
-> (Value -> Parser [ApplicationState])
-> FromJSON ApplicationState
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ApplicationState]
$cparseJSONList :: Value -> Parser [ApplicationState]
parseJSON :: Value -> Parser ApplicationState
$cparseJSON :: Value -> Parser ApplicationState
FromJSON)

-- | Yields the 'ApplicationState' of an 'Async'
stateOf :: (Show a) => Async a -> IO ApplicationState
stateOf :: Async a -> IO ApplicationState
stateOf Async a
x = Maybe (Either SomeException a) -> ApplicationState
forall a.
Show a =>
Maybe (Either SomeException a) -> ApplicationState
fromPollResult (Maybe (Either SomeException a) -> ApplicationState)
-> IO (Maybe (Either SomeException a)) -> IO ApplicationState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Async a -> IO (Maybe (Either SomeException a))
forall a. Async a -> IO (Maybe (Either SomeException a))
poll Async a
x

-- | Converts the result of a 'Control.Concurrent.Async.poll' call to 'ApplicationState'
fromPollResult :: (Show a) => Maybe (Either SomeException a) -> ApplicationState
fromPollResult :: Maybe (Either SomeException a) -> ApplicationState
fromPollResult =
  \case
    Maybe (Either SomeException a)
Nothing -> ApplicationState
Running
    Just (Left SomeException
err) -> String -> ApplicationState
Error (SomeException -> String
forall a. Show a => a -> String
show SomeException
err)
    Just (Right a
val) -> String -> ApplicationState
Finished (a -> String
forall a. Show a => a -> String
show a
val)