lib/Hcompta/Lib/Strict.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE StandaloneDeriving #-}
   3 {-# OPTIONS_GHC -fno-warn-orphans #-}
   4 module Hcompta.Lib.Strict where
   5
   6 import           Control.DeepSeq (NFData(..))
   7 import           Data.Data
   8 import           Data.Eq (Eq)
   9 import           Data.Monoid (Monoid(..))
  10 import qualified Data.Strict.Maybe as Strict
  11 import           Text.Show (Show)
  12 import           Prelude (seq)
  13
  14 -- 'Strict.Maybe' orphans instances
  15
  16 deriving instance -- Data
  17  Data a => Data (Strict.Maybe a)
  18 instance -- Monoid
  19  Monoid a =>
  20  Monoid (Strict.Maybe a) where
  21         mempty = Strict.Nothing
  22         mappend (Strict.Just x) (Strict.Just y) = Strict.Just (x `mappend` y)
  23         mappend x Strict.Nothing = x
  24         mappend Strict.Nothing y = y
  25 instance -- NFData
  26  NFData a =>
  27  NFData (Strict.Maybe a) where
  28         rnf Strict.Nothing  = ()
  29         rnf (Strict.Just x) = rnf x
  30 deriving instance -- Typeable
  31  Typeable Strict.Maybe
  32
  33 -- * Type 'Clusive'
  34
  35 -- A data type to calculate an 'inclusive' value
  36 -- (through some propagation mecanism,
  37 -- eg. incorporating the values of the children of a tree node),
  38 -- while keeping the original 'exclusive' value
  39 -- (eg. the original value of a tree node).
  40 data Clusive a
  41  =   Clusive
  42  { exclusive :: !a
  43  , inclusive :: !a
  44  } deriving (Data, Eq, Show, Typeable)
  45 instance -- Monoid
  46  Monoid a
  47  => Monoid (Clusive a) where
  48         mempty = Clusive mempty mempty
  49         mappend (Clusive e0 i0) (Clusive e1 i1) =
  50                 Clusive (e0`mappend`e1) (i0`mappend`i1)
  51 instance -- NFData
  52  NFData a =>
  53  NFData (Clusive a) where
  54         rnf (Clusive e i)  = rnf e `seq` rnf i