1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# OPTIONS_GHC -fno-warn-orphans #-}
3 module Hcompta.Tag where
5 import Control.Arrow (second)
6 import Control.Applicative (Applicative(..))
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)
25 -- | An 'Tag' is a non-empty list of 'Section'.
26 type Tag = (Path, Value)
28 type Path = NonEmpty Section
30 newtype Tags = Tags (Map Path [Value])
31 deriving (Data, Eq, Show, Typeable)
32 unTags :: Tags -> Map Path [Value]
35 instance Monoid Tags where
37 mappend (Tags x0) (Tags x1) = Tags (Data.Map.unionWith mappend x0 x1)
39 -- | Return the 'Tag' formed by the given 'Path' and 'Value'.
40 tag :: Path -> Value -> Tag
43 -- | Return the 'Value' formed by the given 'Section' and 'Section's.
44 path :: Section -> [Section] -> Path
47 -- | Return the 'Value' of a 'Tag', if any.
48 value :: Tag -> Maybe Value
49 value (_, v) | Text.null v = Nothing
52 -- | Return the number of 'Section's in the given 'Tag'.
54 depth = NonEmpty.length
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)