lcc/Hcompta/LCC/Anchor.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE NamedFieldPuns #-}
   6 {-# LANGUAGE TypeFamilies #-}
   7 {-# OPTIONS_GHC -fno-warn-orphans #-}
   8 module Hcompta.LCC.Anchor where
   9
  10 import Control.DeepSeq (NFData(..))
  11 import Data.Data (Data(..))
  12 import Data.Eq (Eq(..))
  13 import Data.Function (($), flip)
  14 import Data.Map.Strict (Map)
  15 import qualified Data.Map.Strict as Map
  16 import qualified Data.MonoTraversable as MT
  17 import Data.Monoid (Monoid(..))
  18 import Data.NonNull (NonNull)
  19 import Data.Ord (Ord(..))
  20 import Data.Semigroup (Semigroup(..))
  21 import Data.Typeable (Typeable)
  22 import Text.Show (Show)
  23
  24 import Hcompta.LCC.Name
  25
  26 -- * Type 'Anchor'
  27 newtype Anchor = Anchor (NonNull [Name])
  28  deriving (Data, Eq, Ord, MT.MonoFoldable, NFData, Semigroup, Show, Typeable)
  29 -- type instance Seqs.Index Anchor = Int
  30 type instance MT.Element Anchor = Name
  31
  32 -- * Type 'Anchors'
  33 newtype Anchors
  34  =      Anchors (Map Anchor ())
  35  deriving (Data, Eq, NFData, Show, Typeable)
  36 instance Monoid Anchors where
  37         mempty = Anchors mempty
  38         mappend (Anchors x) (Anchors y) =
  39                 Anchors $ Map.unionWith (flip mappend) x y
  40 type instance MT.Element Anchors = Anchor