summaryrefslogtreecommitdiffstats
path: root/tags/src
diff options
context:
space:
mode:
Diffstat (limited to 'tags/src')
-rw-r--r--tags/src/Tag.hs41
-rw-r--r--tags/src/TypedValue.hs33
2 files changed, 74 insertions, 0 deletions
diff --git a/tags/src/Tag.hs b/tags/src/Tag.hs
new file mode 100644
index 0000000..ab7e171
--- /dev/null
+++ b/tags/src/Tag.hs
@@ -0,0 +1,41 @@
+module Tag
+ ( Tag (..),
+ tagKey,
+ tagValue,
+ hasTag,
+ tagValuesOf,
+ )
+where
+
+import Data.Aeson qualified as J
+import Data.Binary (Binary)
+import Data.Maybe (mapMaybe)
+import Data.Set qualified as S
+import Data.Text (Text)
+import GHC.Generics (Generic)
+
+data Tag = Tag Text (Maybe Text)
+ deriving (Show, Generic, Binary, Eq, Ord)
+
+instance J.FromJSON Tag
+
+instance J.ToJSON Tag
+
+tagKey :: Tag -> Text
+tagKey (Tag k _) = k
+
+tagValue :: Tag -> Maybe Text
+tagValue (Tag _ v) = v
+
+hasTag :: Tag -> S.Set Tag -> Bool
+hasTag tag =
+ (tagKey tag `S.member`) . S.map tagKey
+
+tagValuesOf :: Text -> [Tag] -> [Text]
+tagValuesOf key =
+ mapMaybe
+ ( \tag ->
+ if tagKey tag == key
+ then tagValue tag
+ else Nothing
+ )
diff --git a/tags/src/TypedValue.hs b/tags/src/TypedValue.hs
new file mode 100644
index 0000000..c20dce0
--- /dev/null
+++ b/tags/src/TypedValue.hs
@@ -0,0 +1,33 @@
+module TypedValue
+ ( Type (..),
+ cast,
+ castDef,
+ )
+where
+
+import Data.Maybe (fromMaybe)
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Time.Calendar (Day)
+import Text.Read (readMaybe)
+
+data Type a where
+ Date :: Type Day
+ Int :: Type Int
+ String :: Type Text
+
+cast :: (forall a. Ord a => a -> a -> b) -> (Text -> Text -> Maybe b)
+cast eq x y
+ | Just x' <- castTo Date x, Just y' <- castTo Date y = Just (eq x' y')
+ | Just _ <- castTo Date x, Nothing <- castTo Date y = Nothing
+ | Just x' <- castTo Int x, Just y' <- castTo Int y = Just (eq x' y')
+ | Just _ <- castTo Int x, Nothing <- castTo Int y = Nothing
+ | otherwise = Just (eq x y)
+
+castDef :: b -> (forall a. Ord a => a -> a -> b) -> (Text -> Text -> b)
+castDef def eq x y = fromMaybe def (cast eq x y)
+
+castTo :: Type a -> Text -> Maybe a
+castTo Date = readMaybe . T.unpack
+castTo Int = readMaybe . T.unpack
+castTo String = Just