{-# LANGUAGE DeriveGeneric #-}

module Haspara.Accounting.AccountKind where

import qualified Data.Aeson    as Aeson
import qualified Data.Char     as C
import           Data.Hashable (Hashable)
import qualified Data.Text     as T
import           GHC.Generics  (Generic)


data AccountKind =
    AccountKindAsset
  | AccountKindLiability
  | AccountKindEquity
  | AccountKindRevenue
  | AccountKindExpense
  deriving (Int -> AccountKind
AccountKind -> Int
AccountKind -> [AccountKind]
AccountKind -> AccountKind
AccountKind -> AccountKind -> [AccountKind]
AccountKind -> AccountKind -> AccountKind -> [AccountKind]
(AccountKind -> AccountKind)
-> (AccountKind -> AccountKind)
-> (Int -> AccountKind)
-> (AccountKind -> Int)
-> (AccountKind -> [AccountKind])
-> (AccountKind -> AccountKind -> [AccountKind])
-> (AccountKind -> AccountKind -> [AccountKind])
-> (AccountKind -> AccountKind -> AccountKind -> [AccountKind])
-> Enum AccountKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AccountKind -> AccountKind -> AccountKind -> [AccountKind]
$cenumFromThenTo :: AccountKind -> AccountKind -> AccountKind -> [AccountKind]
enumFromTo :: AccountKind -> AccountKind -> [AccountKind]
$cenumFromTo :: AccountKind -> AccountKind -> [AccountKind]
enumFromThen :: AccountKind -> AccountKind -> [AccountKind]
$cenumFromThen :: AccountKind -> AccountKind -> [AccountKind]
enumFrom :: AccountKind -> [AccountKind]
$cenumFrom :: AccountKind -> [AccountKind]
fromEnum :: AccountKind -> Int
$cfromEnum :: AccountKind -> Int
toEnum :: Int -> AccountKind
$ctoEnum :: Int -> AccountKind
pred :: AccountKind -> AccountKind
$cpred :: AccountKind -> AccountKind
succ :: AccountKind -> AccountKind
$csucc :: AccountKind -> AccountKind
Enum, AccountKind -> AccountKind -> Bool
(AccountKind -> AccountKind -> Bool)
-> (AccountKind -> AccountKind -> Bool) -> Eq AccountKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountKind -> AccountKind -> Bool
$c/= :: AccountKind -> AccountKind -> Bool
== :: AccountKind -> AccountKind -> Bool
$c== :: AccountKind -> AccountKind -> Bool
Eq, (forall x. AccountKind -> Rep AccountKind x)
-> (forall x. Rep AccountKind x -> AccountKind)
-> Generic AccountKind
forall x. Rep AccountKind x -> AccountKind
forall x. AccountKind -> Rep AccountKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AccountKind x -> AccountKind
$cfrom :: forall x. AccountKind -> Rep AccountKind x
Generic, Eq AccountKind
Eq AccountKind
-> (AccountKind -> AccountKind -> Ordering)
-> (AccountKind -> AccountKind -> Bool)
-> (AccountKind -> AccountKind -> Bool)
-> (AccountKind -> AccountKind -> Bool)
-> (AccountKind -> AccountKind -> Bool)
-> (AccountKind -> AccountKind -> AccountKind)
-> (AccountKind -> AccountKind -> AccountKind)
-> Ord AccountKind
AccountKind -> AccountKind -> Bool
AccountKind -> AccountKind -> Ordering
AccountKind -> AccountKind -> AccountKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AccountKind -> AccountKind -> AccountKind
$cmin :: AccountKind -> AccountKind -> AccountKind
max :: AccountKind -> AccountKind -> AccountKind
$cmax :: AccountKind -> AccountKind -> AccountKind
>= :: AccountKind -> AccountKind -> Bool
$c>= :: AccountKind -> AccountKind -> Bool
> :: AccountKind -> AccountKind -> Bool
$c> :: AccountKind -> AccountKind -> Bool
<= :: AccountKind -> AccountKind -> Bool
$c<= :: AccountKind -> AccountKind -> Bool
< :: AccountKind -> AccountKind -> Bool
$c< :: AccountKind -> AccountKind -> Bool
compare :: AccountKind -> AccountKind -> Ordering
$ccompare :: AccountKind -> AccountKind -> Ordering
$cp1Ord :: Eq AccountKind
Ord, Int -> AccountKind -> ShowS
[AccountKind] -> ShowS
AccountKind -> String
(Int -> AccountKind -> ShowS)
-> (AccountKind -> String)
-> ([AccountKind] -> ShowS)
-> Show AccountKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountKind] -> ShowS
$cshowList :: [AccountKind] -> ShowS
show :: AccountKind -> String
$cshow :: AccountKind -> String
showsPrec :: Int -> AccountKind -> ShowS
$cshowsPrec :: Int -> AccountKind -> ShowS
Show)


instance Hashable AccountKind


-- | 'Aeson.FromJSON' instance for 'AccountKind'.
--
-- >>> Aeson.decode "\"Asset\"" :: Maybe AccountKind
-- Just AccountKindAsset
-- >>> Aeson.decode "\"aSSET\"" :: Maybe AccountKind
-- Just AccountKindAsset
-- >>> Aeson.decode "\"ASSET\"" :: Maybe AccountKind
-- Just AccountKindAsset
-- >>> Aeson.decode "\"LIABILITY\"" :: Maybe AccountKind
-- Just AccountKindLiability
-- >>> Aeson.decode "\"EQUITY\"" :: Maybe AccountKind
-- Just AccountKindEquity
-- >>> Aeson.decode "\"REVENUE\"" :: Maybe AccountKind
-- Just AccountKindRevenue
-- >>> Aeson.decode "\"EXPENSE\"" :: Maybe AccountKind
-- Just AccountKindExpense
instance Aeson.FromJSON AccountKind where
  parseJSON :: Value -> Parser AccountKind
parseJSON = String
-> (Text -> Parser AccountKind) -> Value -> Parser AccountKind
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"AccountKind" ((Text -> Parser AccountKind) -> Value -> Parser AccountKind)
-> (Text -> Parser AccountKind) -> Value -> Parser AccountKind
forall a b. (a -> b) -> a -> b
$ \Text
t -> case (Char -> Char) -> Text -> Text
T.map Char -> Char
C.toUpper Text
t of
    Text
"ASSET"     -> AccountKind -> Parser AccountKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure AccountKind
AccountKindAsset
    Text
"LIABILITY" -> AccountKind -> Parser AccountKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure AccountKind
AccountKindLiability
    Text
"EQUITY"    -> AccountKind -> Parser AccountKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure AccountKind
AccountKindEquity
    Text
"REVENUE"   -> AccountKind -> Parser AccountKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure AccountKind
AccountKindRevenue
    Text
"EXPENSE"   -> AccountKind -> Parser AccountKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure AccountKind
AccountKindExpense
    Text
_           -> String -> Parser AccountKind
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser AccountKind) -> String -> Parser AccountKind
forall a b. (a -> b) -> a -> b
$ String
"Unknown account kind: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
t


-- | 'Aeson.ToJSON' instance for 'AccountKind'.
--
-- >>> Aeson.encode AccountKindAsset
-- "\"ASSET\""
-- >>> Aeson.encode AccountKindLiability
-- "\"LIABILITY\""
-- >>> Aeson.encode AccountKindEquity
-- "\"EQUITY\""
-- >>> Aeson.encode AccountKindRevenue
-- "\"REVENUE\""
-- >>> Aeson.encode AccountKindExpense
-- "\"EXPENSE\""
instance Aeson.ToJSON AccountKind where
  toJSON :: AccountKind -> Value
toJSON AccountKind
AccountKindAsset     = Text -> Value
Aeson.String Text
"ASSET"
  toJSON AccountKind
AccountKindLiability = Text -> Value
Aeson.String Text
"LIABILITY"
  toJSON AccountKind
AccountKindEquity    = Text -> Value
Aeson.String Text
"EQUITY"
  toJSON AccountKind
AccountKindRevenue   = Text -> Value
Aeson.String Text
"REVENUE"
  toJSON AccountKind
AccountKindExpense   = Text -> Value
Aeson.String Text
"EXPENSE"


accountKindText :: AccountKind -> T.Text
accountKindText :: AccountKind -> Text
accountKindText AccountKind
AccountKindAsset     = Text
"Asset"
accountKindText AccountKind
AccountKindLiability = Text
"Liability"
accountKindText AccountKind
AccountKindEquity    = Text
"Equity"
accountKindText AccountKind
AccountKindRevenue   = Text
"Revenue"
accountKindText AccountKind
AccountKindExpense   = Text
"Expense"