1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE MultiParamTypeClasses #-}
4 {-# LANGUAGE TypeFamilies #-}
5 {-# OPTIONS_GHC -fno-warn-orphans #-}
6 module Hcompta.Anchor where
8 import Control.DeepSeq (NFData(..))
11 import Data.Function (($), (.), id)
12 import Data.Functor (Functor(..))
14 import Data.NonNull (NonNull)
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 qualified Data.Sequences as Seqs
21 import qualified Data.MonoTraversable as MT
22 import Text.Show (Show)
24 import Hcompta.Lib.Consable
30 _Anchor :: Proxy Anchor
34 class Anchor (MT.Element as) => Anchors as
35 _Anchors :: Proxy Anchors
39 class Anchor (Anchors_Anchor as) => Anchors as where
40 type Anchors_Anchor as
42 type Anchor = Anchor_Path
43 type Anchor_Section = Name
44 type Anchor_Path = NonNull [Anchor_Section]
48 = Anchors (Map Anchor_Path ())
49 deriving (Data, Eq, NFData, Show, Typeable
50 , MT.MonoFunctor, MT.MonoFoldable)
51 -- TODO: use Data.Set?
52 unAnchors :: Anchors -> Map Anchor ()
53 unAnchors (Anchors m) = m
57 instance Monoid Anchors where
58 mempty = Anchors mempty
59 mappend (Anchors x0) (Anchors x1) = Anchors (mappend x0 x1)
60 instance Consable Anchor Anchors where
62 instance NFData Anchors where
63 rnf (Anchors m) = rnf m
65 -- | Return the given 'Anchors' with the given 'Anchor' incorporated.
66 anchor_cons :: Anchor -> Anchors -> Anchors
67 anchor_cons a (Anchors as) = Anchors $ mcons (a, ()) as
69 -- | Return the 'Anchor' formed by the given 'Anchor_Path' and 'Value'.
70 anchor :: Anchor_Path -> Anchor
73 -- | Return the 'Value' formed by the given 'Anchor_Section' and 'Anchor_Section's.
74 anchor_path :: Anchor_Section -> [Anchor_Section] -> Anchor_Path
77 -- | Return the number of 'Anchor_Section's in the given 'Anchor'.
78 anchor_depth :: Anchor_Path -> Int
79 anchor_depth = NonEmpty.length
81 -- | Return a 'Anchor_Path' from the given list.
82 anchor_from_List :: [Anchor] -> Anchors
83 anchor_from_List = Anchors . Map.fromList . fmap (, ())