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

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

import           Hcompta.Lib.Consable

-- * The 'Tag' type

-- | An 'Tag' is a non-empty list of 'Section'.
type Tag = (Path, Value)
type Section   = Text
type Path      = NonEmpty Section
type Value     = Text
newtype Tags
 =      Tags (Map Path [Value])
 deriving (Data, Eq, Show, Typeable)
unTags :: Tags -> Map Path [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 = cons
instance NFData Tags where
	rnf (Tags m) = rnf m

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

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

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

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

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

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