lib/Hcompta/Anchor.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE TupleSections #-}
   6 {-# OPTIONS_GHC -fno-warn-orphans #-}
   7 module Hcompta.Anchor where
   8
   9 import           Control.DeepSeq (NFData(..))
  10 import           Data.Data
  11 import           Data.Eq (Eq)
  12 import           Data.Function (($), (.), id)
  13 import           Data.Functor (Functor(..))
  14 import           Data.Int (Int)
  15 import           Data.List.NonEmpty (NonEmpty(..))
  16 import qualified Data.List.NonEmpty as NonEmpty
  17 import           Data.Map.Strict (Map)
  18 import qualified Data.Map.Strict as Map
  19 import           Data.Monoid (Monoid(..))
  20 import           Data.Text (Text)
  21 import           Data.Typeable ()
  22 import           Text.Show (Show)
  23
  24 import           Hcompta.Lib.Consable
  25
  26 -- * Type 'Anchor'
  27
  28 -- | An 'Anchor' is a non-empty list of 'Anchor_Section'.
  29 type Anchor         = Anchor_Path
  30 type Anchor_Section = Text
  31 type Anchor_Path    = NonEmpty Anchor_Section
  32
  33 -- * Type 'Anchors'
  34
  35 newtype Anchors
  36  =      Anchors (Map Anchor_Path ())
  37  deriving (Data, Eq, Show, Typeable)
  38  -- TODO: use Data.Set?
  39 unAnchors :: Anchors -> Map Anchor ()
  40 unAnchors (Anchors m) = m
  41
  42 instance Monoid Anchors where
  43         mempty = Anchors mempty
  44         mappend (Anchors x0) (Anchors x1) = Anchors (mappend x0 x1)
  45 instance Consable Anchor Anchors where
  46         mcons = anchor_cons
  47 instance NFData Anchors where
  48         rnf (Anchors m) = rnf m
  49
  50 -- | Return the given 'Anchors' with the given 'Anchor' incorporated.
  51 anchor_cons :: Anchor -> Anchors -> Anchors
  52 anchor_cons a (Anchors as) = Anchors $ mcons (a, ()) as
  53
  54 -- | Return the 'Anchor' formed by the given 'Anchor_Path' and 'Value'.
  55 anchor :: Anchor_Path -> Anchor
  56 anchor = id
  57
  58 -- | Return the 'Value' formed by the given 'Anchor_Section' and 'Anchor_Section's.
  59 anchor_path :: Anchor_Section -> [Anchor_Section] -> Anchor_Path
  60 anchor_path = (:|)
  61
  62 -- | Return the number of 'Anchor_Section's in the given 'Anchor'.
  63 anchor_depth :: Anchor_Path -> Int
  64 anchor_depth = NonEmpty.length
  65
  66 -- | Return a 'Anchor_Path' from the given list.
  67 anchor_from_List :: [Anchor] -> Anchors
  68 anchor_from_List = Anchors . Map.fromList . fmap (, ())