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

import           Control.Applicative (Applicative(..))
import           Control.Arrow (second)
import           Control.DeepSeq (NFData(..))
import           Data.Data
import           Data.Eq (Eq)
import           Data.Function (($), (.), flip)
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 Data.Map
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Typeable ()
import           Text.Show (Show)

import           Hcompta.Lib.Consable

-- * The 'Tag' type

-- | An 'Tag' is a non-empty list of 'Tag_Section'.
type Tag = (Tag_Path, Tag_Value)
type Tag_Section   = Text
type Tag_Path      = NonEmpty Tag_Section
type Tag_Value     = Text

-- * Type 'Tags'
newtype Tags
 =      Tags (Map Tag_Path [Tag_Value])
 deriving (Data, Eq, Show, Typeable)
unTags :: Tags -> Map Tag_Path [Tag_Value]
unTags (Tags m) = m

instance Monoid Tags where
	mempty = Tags mempty
	mappend (Tags x0) (Tags x1) =
		Tags (Data.Map.unionWith mappend x0 x1)
instance Consable Tag Tags where
	mcons = tag_cons
instance NFData Tags where
	rnf (Tags m) = rnf m

-- | Return the given 'Tags' with the given 'Tag' incorporated.
tag_cons :: Tag -> Tags -> Tags
tag_cons (p, v) (Tags xs) = Tags $ mcons (p, [v]) xs

-- | Return the 'Tag' formed by the given 'Tag_Path' and 'Tag_Value'.
tag :: Tag_Path -> Tag_Value -> Tag
tag = (,)

-- | Return the 'Tag_Value' formed by the given 'Tag_Section' and 'Tag_Section's.
tag_path :: Tag_Section -> [Tag_Section] -> Tag_Path
tag_path = (:|)

-- | Return the 'Tag_Value' of a 'Tag', if any.
tag_value :: Tag -> Maybe Tag_Value
tag_value (_, v) | Text.null v = Nothing
tag_value (_, v) = Just v

-- | Return the number of 'Tag_Section's in the given 'Tag'.
tag_depth :: Tag_Path -> Int
tag_depth = NonEmpty.length

-- | Return a 'Tag_Path' from the given list.
tag_from_List :: [(Tag_Path, Tag_Value)] -> Tags
tag_from_List = Tags . Data.Map.fromListWith (flip mappend) . fmap (second pure)