-- Copyright 2018 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Tags type and conventional tag values.
module Solkattu.Tags where
import qualified Data.Map as Map
import qualified Util.Maps as Maps
import Global


newtype Tags = Tags (Map Text [Text])
    deriving (Tags -> Tags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tags -> Tags -> Bool
$c/= :: Tags -> Tags -> Bool
== :: Tags -> Tags -> Bool
$c== :: Tags -> Tags -> Bool
Eq, Int -> Tags -> ShowS
[Tags] -> ShowS
Tags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tags] -> ShowS
$cshowList :: [Tags] -> ShowS
show :: Tags -> String
$cshow :: Tags -> String
showsPrec :: Int -> Tags -> ShowS
$cshowsPrec :: Int -> Tags -> ShowS
Show, [Tags] -> Doc
Tags -> Text
Tags -> Doc
forall a. (a -> Text) -> (a -> Doc) -> ([a] -> Doc) -> Pretty a
formatList :: [Tags] -> Doc
$cformatList :: [Tags] -> Doc
format :: Tags -> Doc
$cformat :: Tags -> Doc
pretty :: Tags -> Text
$cpretty :: Tags -> Text
Pretty)

instance Semigroup Tags where
    Tags Map Text [Text]
t1 <> :: Tags -> Tags -> Tags
<> Tags Map Text [Text]
t2 = Map Text [Text] -> Tags
Tags (forall k a. (Ord k, Monoid a) => Map k a -> Map k a -> Map k a
Maps.mappend Map Text [Text]
t1 Map Text [Text]
t2)
instance Monoid Tags where
    mempty :: Tags
mempty = Map Text [Text] -> Tags
Tags forall a. Monoid a => a
mempty
    mappend :: Tags -> Tags -> Tags
mappend = forall a. Semigroup a => a -> a -> a
(<>)

tag :: Text -> Text -> Tags
tag :: Text -> Text -> Tags
tag Text
k Text
v = Map Text [Text] -> Tags
Tags (forall k a. k -> a -> Map k a
Map.singleton Text
k [Text
v])

untags :: Tags -> Map Text [Text]
untags :: Tags -> Map Text [Text]
untags (Tags Map Text [Text]
tags) = Map Text [Text]
tags

replace :: Text -> Text -> Tags -> Tags
replace :: Text -> Text -> Tags -> Tags
replace Text
k Text
v (Tags Map Text [Text]
tags) = Map Text [Text] -> Tags
Tags forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Text
k [Text
v] Map Text [Text]
tags

-- * tags

comment :: Text
comment :: Text
comment = Text
"comment"

source :: Text
source :: Text
source = Text
"source"

type_ :: Text
type_ :: Text
type_ = Text
"type"

withType :: Text -> Tags
withType :: Text -> Tags
withType = Text -> Text -> Tags
tag Text
type_

exercise :: Text
exercise :: Text
exercise = Text
"exercise"

-- ** per-korvai

similarTo :: Text
similarTo :: Text
similarTo = Text
"similar_to"

recording :: Text
recording :: Text
recording = Text
"recording"

-- ** per-section

development, variation, ending :: Text
development :: Text
development = Text
"development"
variation :: Text
variation = Text
"variation"
ending :: Text
ending = Text
"ending"

eddupu :: Text
eddupu :: Text
eddupu = Text
"eddupu"

date :: Text
date :: Text
date = Text
"date"

times :: Text
times :: Text
times = Text
"times"