{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE NoImplicitPrelude         #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE StrictData                #-}

{-|
Module      : Headroom.Types
Description : Application data types
Copyright   : (c) 2019-2021 Vaclav Svejcar
License     : BSD-3-Clause
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Module containing most of the data types used by the application.
-}

module Headroom.Types
  ( -- * Error Data Types
    HeadroomError(..)
    -- ** Helper Functions
  , fromHeadroomError
  , toHeadroomError
    -- * Other Data Types
  , CurrentYear(..)
  )
where

import           Data.Typeable                       ( cast )
import           RIO


-- | Top-level of the /Headroom/ exception hierarchy.
data HeadroomError = forall e . Exception e => HeadroomError e

instance Show HeadroomError where
  show :: HeadroomError -> String
show (HeadroomError e
he) = e -> String
forall a. Show a => a -> String
show e
he

instance Exception HeadroomError where
  displayException :: HeadroomError -> String
displayException (HeadroomError e
he) = e -> String
forall e. Exception e => e -> String
displayException e
he


-- | Wraps given exception into 'HeadroomError'.
toHeadroomError :: Exception e
                => e
                -- ^ exception to wrap
                -> SomeException
                -- ^ wrapped exception
toHeadroomError :: e -> SomeException
toHeadroomError = HeadroomError -> SomeException
forall e. Exception e => e -> SomeException
toException (HeadroomError -> SomeException)
-> (e -> HeadroomError) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> HeadroomError
forall e. Exception e => e -> HeadroomError
HeadroomError


-- | Unwraps given exception from 'HeadroomError'.
fromHeadroomError :: Exception e
                  => SomeException
                  -- ^ exception to unwrap
                  -> Maybe e
                  -- ^ unwrapped exception
fromHeadroomError :: SomeException -> Maybe e
fromHeadroomError SomeException
e = do
  HeadroomError e
he <- SomeException -> Maybe HeadroomError
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
  e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
he


-- | Wraps the value of current year.
newtype CurrentYear = CurrentYear
  { CurrentYear -> Integer
unCurrentYear :: Integer
  -- ^ value of current year
  }
  deriving (CurrentYear -> CurrentYear -> Bool
(CurrentYear -> CurrentYear -> Bool)
-> (CurrentYear -> CurrentYear -> Bool) -> Eq CurrentYear
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CurrentYear -> CurrentYear -> Bool
$c/= :: CurrentYear -> CurrentYear -> Bool
== :: CurrentYear -> CurrentYear -> Bool
$c== :: CurrentYear -> CurrentYear -> Bool
Eq, Int -> CurrentYear -> ShowS
[CurrentYear] -> ShowS
CurrentYear -> String
(Int -> CurrentYear -> ShowS)
-> (CurrentYear -> String)
-> ([CurrentYear] -> ShowS)
-> Show CurrentYear
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurrentYear] -> ShowS
$cshowList :: [CurrentYear] -> ShowS
show :: CurrentYear -> String
$cshow :: CurrentYear -> String
showsPrec :: Int -> CurrentYear -> ShowS
$cshowsPrec :: Int -> CurrentYear -> ShowS
Show)