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.Functor (Functor(..))
  13 import           Data.List.NonEmpty (NonEmpty(..))
  14 import qualified Data.List.NonEmpty as NonEmpty
  15 import           Data.Map.Strict (Map)
  16 import qualified Data.Map.Strict as Map
  17 import           Data.Monoid (Monoid(..))
  18 import           Data.Text (Text)
  19 import           Data.Typeable ()
  20 import           Prelude (($), (.), Int, id)
  21 import           Text.Show (Show)
  22
  23 import           Hcompta.Lib.Consable
  24
  25 -- * The 'Anchor' type
  26
  27 -- | An 'Anchor' is a non-empty list of 'Section'.
  28 type Anchor  = Path
  29 type Section = Text
  30 type Path    = NonEmpty Section
  31 newtype Anchors
  32  =      Anchors (Map Path ())
  33  deriving (Data, Eq, Show, Typeable)
  34 unAnchors :: Anchors -> Map Anchor ()
  35 unAnchors (Anchors m) = m
  36
  37 instance Monoid Anchors where
  38         mempty = Anchors mempty
  39         mappend (Anchors x0) (Anchors x1) = Anchors (mappend x0 x1)
  40 instance Consable Anchor Anchors where
  41         mcons = cons
  42 instance NFData Anchors where
  43         rnf (Anchors m) = rnf m
  44
  45 -- | Return the given 'Anchors' with the given 'Anchor' incorporated.
  46 cons :: Anchor -> Anchors -> Anchors
  47 cons a (Anchors as) = Anchors $ mcons (a, ()) as
  48
  49 -- | Return the 'Anchor' formed by the given 'Path' and 'Value'.
  50 anchor :: Path -> Anchor
  51 anchor = id
  52
  53 -- | Return the 'Value' formed by the given 'Section' and 'Section's.
  54 path :: Section -> [Section] -> Path
  55 path = (:|)
  56
  57 -- | Return the number of 'Section's in the given 'Anchor'.
  58 depth :: Path -> Int
  59 depth = NonEmpty.length
  60
  61 -- | Return a 'Path' from the given list.
  62 from_List :: [Anchor] -> Anchors
  63 from_List = Anchors . Map.fromList . fmap (, ())