lib/Hcompta/Tag.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# OPTIONS_GHC -fno-warn-orphans #-}
   3 module Hcompta.Tag where
   4
   5 import           Control.Arrow (second)
   6 import           Control.Applicative (Applicative(..))
   7 import           Control.DeepSeq (NFData(..))
   8 import           Data.Data
   9 import           Data.Eq (Eq)
  10 import           Data.Function (flip)
  11 import           Data.Functor (Functor(..))
  12 import           Data.List.NonEmpty (NonEmpty(..))
  13 import qualified Data.List.NonEmpty as NonEmpty
  14 import           Data.Map.Strict (Map)
  15 import qualified Data.Map.Strict as Data.Map
  16 import           Data.Maybe (Maybe(..))
  17 import           Data.Monoid (Monoid(..))
  18 import           Data.Text (Text)
  19 import qualified Data.Text as Text
  20 import           Data.Typeable ()
  21 import           Prelude ((.), Int)
  22 import           Text.Show (Show)
  23
  24 -- * The 'Tag' type
  25
  26 -- | An 'Tag' is a non-empty list of 'Section'.
  27 type Tag     = (Path, Value)
  28 type Section = Text
  29 type Path    = NonEmpty Section
  30 type Value   = Text
  31 newtype Tags = Tags (Map Path [Value])
  32  deriving (Data, Eq, Show, Typeable)
  33 unTags :: Tags -> Map Path [Value]
  34 unTags (Tags m) = m
  35
  36 instance Monoid Tags where
  37         mempty = Tags mempty
  38         mappend (Tags x0) (Tags x1) = Tags (Data.Map.unionWith mappend x0 x1)
  39 instance NFData Tags where
  40         rnf (Tags m) = rnf m
  41
  42 -- | Return the 'Tag' formed by the given 'Path' and 'Value'.
  43 tag :: Path -> Value -> Tag
  44 tag = (,)
  45
  46 -- | Return the 'Value' formed by the given 'Section' and 'Section's.
  47 path :: Section -> [Section] -> Path
  48 path = (:|)
  49
  50 -- | Return the 'Value' of a 'Tag', if any.
  51 value :: Tag -> Maybe Value
  52 value (_, v) | Text.null v = Nothing
  53 value (_, v) = Just v
  54
  55 -- | Return the number of 'Section's in the given 'Tag'.
  56 depth :: Path -> Int
  57 depth = NonEmpty.length
  58
  59 -- | Return a 'Path' from the given list.
  60 from_List :: [Tag] -> Tags
  61 from_List = Tags . Data.Map.fromListWith (flip mappend) . fmap (second pure)