lib/Hcompta/Anchor.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE MultiParamTypeClasses #-}
   4 {-# LANGUAGE TypeFamilies #-}
   5 {-# OPTIONS_GHC -fno-warn-orphans #-}
   6 module Hcompta.Anchor where
   7
   8 import           Control.DeepSeq (NFData(..))
   9 import           Data.Data
  10 import           Data.Eq (Eq)
  11 import           Data.Function (($), (.), id)
  12 import           Data.Functor (Functor(..))
  13 import           Data.Int (Int)
  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)
  23
  24 import           Hcompta.Lib.Consable
  25 import           Hcompta.Name
  26
  27 -- * Class 'Anchor'
  28 class Anchor a
  29
  30 _Anchor :: Proxy Anchor
  31 _Anchor = Proxy
  32
  33 -- * Class 'Anchors'
  34 class Anchor (MT.Element as) => Anchors as
  35 _Anchors :: Proxy Anchors
  36 _Anchors = Proxy
  37
  38 {-
  39 class Anchor (Anchors_Anchor as) => Anchors as where
  40         type Anchors_Anchor as
  41 -- * Type 'Anchor'
  42 type Anchor         = Anchor_Path
  43 type Anchor_Section = Name
  44 type Anchor_Path    = NonNull [Anchor_Section]
  45
  46 -- * Type 'Anchors'
  47 newtype Anchors
  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
  54 -}
  55
  56 {-
  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
  61         mcons = anchor_cons
  62 instance NFData Anchors where
  63         rnf (Anchors m) = rnf m
  64
  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
  68
  69 -- | Return the 'Anchor' formed by the given 'Anchor_Path' and 'Value'.
  70 anchor :: Anchor_Path -> Anchor
  71 anchor = id
  72
  73 -- | Return the 'Value' formed by the given 'Anchor_Section' and 'Anchor_Section's.
  74 anchor_path :: Anchor_Section -> [Anchor_Section] -> Anchor_Path
  75 anchor_path = (:|)
  76
  77 -- | Return the number of 'Anchor_Section's in the given 'Anchor'.
  78 anchor_depth :: Anchor_Path -> Int
  79 anchor_depth = NonEmpty.length
  80
  81 -- | Return a 'Anchor_Path' from the given list.
  82 anchor_from_List :: [Anchor] -> Anchors
  83 anchor_from_List = Anchors . Map.fromList . fmap (, ())
  84 -}