{-# LANGUAGE DeriveDataTypeable #-}
module Hcompta.Amount.Style where

import           Control.DeepSeq
import           Data.Bool
import           Data.Char (Char)
import           Data.Data
import           Data.Eq (Eq(..))
import           Data.Maybe (Maybe(..), maybe)
import           Data.Ord (Ord(..))
import           Data.Typeable ()
import           Data.Word (Word8)
import           Prelude (Int, Show(..), const, seq)

-- * Type 'Style'

data Style
 =   Style
 { fractioning         :: Maybe Fractioning
 , grouping_integral   :: Maybe Grouping
 , grouping_fractional :: Maybe Grouping
 , precision           :: Precision
 -- TODO: , sign_plus           :: Maybe Bool
 , unit_side           :: Maybe Side
 , unit_spaced         :: Maybe Spacing
 } deriving (Data, Eq, Ord, Show, Typeable)
instance NFData Style where
	rnf (Style f gi gf p ui up) =
		rnf f `seq`
		rnf gi `seq`
		rnf gf `seq`
		rnf p `seq`
		rnf ui `seq`
		rnf up

type Fractioning
 = Char

data Grouping
 =   Grouping Char [Int]
 deriving (Data, Eq, Ord, Show, Typeable)
instance NFData Grouping where
	rnf (Grouping s d) = rnf s `seq` rnf d

type Precision
 = Word8

type Spacing
 = Bool

data Side
 =   Side_Left
 |   Side_Right
 deriving (Data, Eq, Ord, Show, Typeable)
instance NFData Side where
	rnf Side_Left = ()
	rnf Side_Right = ()

-- * Constructors

nil :: Style
nil =
	Style
	 { fractioning = Nothing
	 , grouping_integral = Nothing
	 , grouping_fractional = Nothing
	 , precision = 0
	 , unit_side = Nothing
	 , unit_spaced = Nothing
	 }

-- * Operators

union :: Style -> Style -> Style
union
 style@Style
 { fractioning=fractioning_
 , grouping_integral=grouping_integral_
 , grouping_fractional=grouping_fractional_
 , precision=precision_
 , unit_side=side
 , unit_spaced=spaced
 }
 style'@Style
 { fractioning=fractioning'
 , grouping_integral=grouping_integral_'
 , grouping_fractional=grouping_fractional_'
 , precision=precision'
 , unit_side=side'
 , unit_spaced=spaced'
 } =
	if style == style'
	then style'
	else
		Style
		 { fractioning=maybe fractioning' (const fractioning_) fractioning_
		 , grouping_integral=maybe grouping_integral_' (const grouping_integral_) grouping_integral_
		 , grouping_fractional=maybe grouping_fractional_' (const grouping_fractional_) grouping_fractional_
		 , precision=max precision_ precision'
		 , unit_side=maybe side' (const side) side
		 , unit_spaced=maybe spaced' (const spaced) spaced
		 }