module Propellor.Types.Result where

import System.Console.ANSI
import qualified Data.Semigroup as Sem
import Data.Monoid
import Prelude

-- | There can be three results of satisfying a Property.
data Result = NoChange | MadeChange | FailedChange
	deriving (ReadPrec [Result]
ReadPrec Result
Int -> ReadS Result
ReadS [Result]
(Int -> ReadS Result)
-> ReadS [Result]
-> ReadPrec Result
-> ReadPrec [Result]
-> Read Result
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Result]
$creadListPrec :: ReadPrec [Result]
readPrec :: ReadPrec Result
$creadPrec :: ReadPrec Result
readList :: ReadS [Result]
$creadList :: ReadS [Result]
readsPrec :: Int -> ReadS Result
$creadsPrec :: Int -> ReadS Result
Read, Int -> Result -> ShowS
[Result] -> ShowS
Result -> String
(Int -> Result -> ShowS)
-> (Result -> String) -> ([Result] -> ShowS) -> Show Result
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Result] -> ShowS
$cshowList :: [Result] -> ShowS
show :: Result -> String
$cshow :: Result -> String
showsPrec :: Int -> Result -> ShowS
$cshowsPrec :: Int -> Result -> ShowS
Show, Result -> Result -> Bool
(Result -> Result -> Bool)
-> (Result -> Result -> Bool) -> Eq Result
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result -> Result -> Bool
$c/= :: Result -> Result -> Bool
== :: Result -> Result -> Bool
$c== :: Result -> Result -> Bool
Eq)

instance Sem.Semigroup Result where
	Result
FailedChange <> :: Result -> Result -> Result
<> Result
_ = Result
FailedChange
	Result
_ <> Result
FailedChange = Result
FailedChange
	Result
MadeChange <> Result
_ = Result
MadeChange
	Result
_ <> Result
MadeChange = Result
MadeChange
	Result
NoChange <> Result
NoChange = Result
NoChange

instance Monoid Result where
	mempty :: Result
mempty = Result
NoChange
	mappend :: Result -> Result -> Result
mappend = Result -> Result -> Result
forall a. Semigroup a => a -> a -> a
(Sem.<>)

class ToResult t where
	toResult :: t -> Result

instance ToResult Bool where
	toResult :: Bool -> Result
toResult Bool
False = Result
FailedChange
	toResult Bool
True = Result
MadeChange

instance ToResult Result where
	toResult :: Result -> Result
toResult = Result -> Result
forall a. a -> a
id

-- | Results of actions, with color.
class ActionResult a where
	getActionResult :: a -> (String, ColorIntensity, Color)

instance ActionResult Bool where
	getActionResult :: Bool -> (String, ColorIntensity, Color)
getActionResult Bool
False = (String
"failed", ColorIntensity
Vivid, Color
Red)
	getActionResult Bool
True = (String
"done", ColorIntensity
Dull, Color
Green)

instance ActionResult Result where
	getActionResult :: Result -> (String, ColorIntensity, Color)
getActionResult Result
NoChange = (String
"ok", ColorIntensity
Dull, Color
Green)
	getActionResult Result
MadeChange = (String
"done", ColorIntensity
Vivid, Color
Green)
	getActionResult Result
FailedChange = (String
"failed", ColorIntensity
Vivid, Color
Red)