{-# 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.Function (($), (.), id)
import           Data.Functor (Functor(..))
import           Data.Int (Int)
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           Text.Show (Show)

import           Hcompta.Lib.Consable

-- * Type 'Anchor'

-- | An 'Anchor' is a non-empty list of 'Anchor_Section'.
type Anchor         = Anchor_Path
type Anchor_Section = Text
type Anchor_Path    = NonEmpty Anchor_Section

-- * Type 'Anchors'

newtype Anchors
 =      Anchors (Map Anchor_Path ())
 deriving (Data, Eq, Show, Typeable)
 -- TODO: use Data.Set?
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 = anchor_cons
instance NFData Anchors where
	rnf (Anchors m) = rnf m

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

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

-- | Return the 'Value' formed by the given 'Anchor_Section' and 'Anchor_Section's.
anchor_path :: Anchor_Section -> [Anchor_Section] -> Anchor_Path
anchor_path = (:|)

-- | Return the number of 'Anchor_Section's in the given 'Anchor'.
anchor_depth :: Anchor_Path -> Int
anchor_depth = NonEmpty.length

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