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