{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.Anchor where

import           Control.DeepSeq (NFData(..))
import           Data.Data
import           Data.Eq (Eq)
import           Data.Functor (Functor(..))
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Monoid (Monoid(..))
import           Data.Text (Text)
import           Data.Typeable ()
import           Prelude (($), (.), Int, id)
import           Text.Show (Show)

import           Hcompta.Lib.Consable

-- * The 'Anchor' type

-- | An 'Anchor' is a non-empty list of 'Section'.
type Anchor  = Path
type Section = Text
type Path    = NonEmpty Section
newtype Anchors
 =      Anchors (Map Path ())
 deriving (Data, Eq, Show, Typeable)
unAnchors :: Anchors -> Map Anchor ()
unAnchors (Anchors m) = m

instance Monoid Anchors where
	mempty = Anchors mempty
	mappend (Anchors x0) (Anchors x1) = Anchors (mappend x0 x1)
instance Consable Anchor Anchors where
	mcons = cons
instance NFData Anchors where
	rnf (Anchors m) = rnf m

-- | Return the given 'Anchors' with the given 'Anchor' incorporated.
cons :: Anchor -> Anchors -> Anchors
cons a (Anchors as) = Anchors $ mcons (a, ()) as

-- | Return the 'Anchor' formed by the given 'Path' and 'Value'.
anchor :: Path -> Anchor
anchor = id

-- | Return the 'Value' formed by the given 'Section' and 'Section's.
path :: Section -> [Section] -> Path
path = (:|)

-- | Return the number of 'Section's in the given 'Anchor'.
depth :: Path -> Int
depth = NonEmpty.length

-- | Return a 'Path' from the given list.
from_List :: [Anchor] -> Anchors
from_List = Anchors . Map.fromList . fmap (, ())