lib/Hcompta/Lib/Strict.hs

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