{-# 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.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Proxy (Proxy(..))
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import qualified Data.Sequences as Seqs
import           Data.NonNull (NonNull)
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Tuple (fst, snd)
import           Data.Typeable ()
import           Text.Show (Show)
import qualified Data.MonoTraversable as MT

import           Hcompta.Lib.Consable
import           Hcompta.Name
import           Hcompta.Has
-- import           Language.Symantic as Sym

-- * Class 'Tag'
class
 ( HasI Tag_Path a
 , HasI Tag_Data a
 ) => Tag a

class Tag_Path t
class Tag_Data t
class Tag (MT.Element ts) => Tags ts

{-
class Tag t where
	type Tag_Path t
	type Tag_Data t
	tag_path  :: t -> Tag_Path t
	tag_value :: t -> Tag_Data t
instance Tag       (path, value) where
	type   Tag_Path  (path, value) = path
	type   Tag_Data (path, value) = value
	tag_path  = fst
	tag_value = snd

-- * Class 'Tags'
class Tag (Tags_Tag ts) => Tags ts where
	type Tags_Tag ts
instance
 Tag t =>
 Tags [t] where
	type Tags_Tag [t] = t
instance
 Tags ts =>
 Tags (Map path ts) where
	type Tags_Tag (Map path ts) = Tags_Tag ts
-}
{-
-- * Class 'Tags_of'
class Tags (Tags_Of a) => Tags_of a where
	type Tags_Of a
	tags_of :: a -> Tags_Of a
-}

{-
-- * The 'Tag' type

-- | An 'Tag' is a non-empty list of 'Tag_Section'.
type Tag         = (Tag_Path, Tag_Data)
type Tag_Path    = NonNull [Tag_Section]
type Tag_Section = Name
type Tag_Data   = Text

-- * Type 'Tags'
newtype Tags
 =      Tags (Map Tag_Path [Tag_Data])
 deriving (Data, Eq, NFData, Show, Typeable
 , MT.MonoFunctor, MT.MonoFoldable)
unTags :: Tags -> Map Tag_Path [Tag_Data]
unTags (Tags m) = m
-}


{-
instance Monoid Tags where
	mempty = Tags mempty
	mappend (Tags x) (Tags y) =
		Tags (Map.unionWith (flip mappend) x y)
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_Data'.
tag :: Tag_Path -> Tag_Data -> Tag
tag = (,)

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

-- | Return the 'Tag_Data' of a 'Tag', if any.
tag_value :: Tag -> Maybe Tag_Data
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_Data)] -> Tags
tag_from_List = Tags . Map.fromListWith (flip mappend) . fmap (second pure)
-}