Fix Haddock markup.
[comptalang.git] / lcc / Hcompta / LCC / Tag.hs
index 55c9698664597d060c9dbf23e56677804a1ee51e..cae544335786b99c1896198f10217166a1e7c608 100644 (file)
@@ -11,51 +11,54 @@ import Control.DeepSeq (NFData(..))
 import Data.Data (Data(..))
 import Data.Eq (Eq(..))
 import Data.Function (($), flip)
-import Data.List.NonEmpty (NonEmpty)
-import Data.Map.Strict (Map)
-import qualified Data.Map.Strict as Map
-import qualified Data.MonoTraversable as MT
 import Data.Monoid (Monoid(..))
 import Data.NonNull (NonNull)
 import Data.Ord (Ord(..))
 import Data.Semigroup (Semigroup(..))
 import Data.Text (Text)
 import Data.TreeMap.Strict (TreeMap)
-import qualified Data.TreeMap.Strict as TreeMap
 import Data.Typeable (Typeable)
 import Prelude (seq)
 import Text.Show (Show)
+import qualified Data.MonoTraversable as MT
+import qualified Data.TreeMap.Strict as TreeMap
 
-import qualified Hcompta as H
+import qualified Hcompta as H ()
 import Hcompta.LCC.Name
 
 -- * Type 'Tag'
 data Tag
  =   Tag
- { tag_path  :: Tag_Path
- , tag_value :: Tag_Value
- }
- deriving (Data, Eq, Show, Typeable)
+ {   tag_path :: Tag_Path
+ ,   tag_data :: Tag_Data
+ } deriving (Data, Eq, Ord, Show, Typeable)
+
 instance NFData Tag where
-       rnf (Tag p v) = rnf p `seq` rnf v
+       rnf (Tag p d) = rnf p `seq` rnf d
 
 -- ** Type 'Tag_Path'
-newtype Tag_Path = Tag_Path (NonEmpty Tag_Path_Section)
+newtype Tag_Path = Tag_Path (NonNull [Tag_Path_Section])
  deriving (Data, Eq, NFData, Ord, Semigroup, Show, Typeable)
-instance H.Tag_Path Tag_Path
+
+-- instance H.Tag_Path Tag_Path
 type Tag_Path_Section = Name
 
--- ** Type 'Tag_Value'
-newtype Tag_Value = Tag_Value Text
- deriving (Data, Eq, NFData, Show, Typeable)
-instance H.Tag_Value Tag_Value
+-- ** Type 'Tag_Data'
+newtype Tag_Data = Tag_Data Text
+ deriving (Data, Eq, NFData, Ord, Show, Typeable)
+
+-- instance H.Tag_Data Tag_Data
 
 -- * Type 'Tags'
 newtype Tags
- =      Tags (TreeMap Tag_Path_Section [Tag_Value])
- deriving (Data, Eq, NFData, Show, Typeable)
-instance Monoid Tags where
-       mempty = Tags mempty
-       mappend (Tags x) (Tags y) =
-               Tags $ TreeMap.union (flip mappend) x y
+ =      Tags (TreeMap Tag_Path_Section [Tag_Data])
+ deriving (Data, Eq, NFData, Ord, Show, Typeable)
+
 type instance MT.Element Tags = Tag
+
+instance Semigroup Tags where
+       Tags x <> Tags y =
+               Tags $ TreeMap.union (flip (<>)) x y
+instance Monoid Tags where
+       mempty  = Tags mempty
+       mappend = (<>)