Init

1 files changed, 135 insertions, 0 deletions

diff --git a/src/Data/JLD/Model/Keyword.hs b/src/Data/JLD/Model/Keyword.hs
new file mode 100644
index 0000000..10835a9
--- /dev/null
+++ b/src/Data/JLD/Model/Keyword.hs
@@ -0,0 +1,135 @@
+module Data.JLD.Model.Keyword (
+    Keyword (..),
+    parseKeyword,
+    isKeyword,
+    isNotKeyword,
+    allKeywords,
+    isKeywordLike,
+) where
+
+import Data.JLD.Prelude hiding (show)
+
+import Data.Char (isAlpha)
+import Data.Foldable qualified as F
+import Data.Text qualified as T (all, null, uncons)
+import Text.Show (Show (..))
+
+data Keyword
+    = KeywordAny
+    | KeywordBase
+    | KeywordContainer
+    | KeywordContext
+    | KeywordDefault
+    | KeywordDirection
+    | KeywordEmbed
+    | KeywordExplicit
+    | KeywordFirst
+    | KeywordGraph
+    | KeywordId
+    | KeywordImport
+    | KeywordIncluded
+    | KeywordIndex
+    | KeywordJson
+    | KeywordLanguage
+    | KeywordList
+    | KeywordNest
+    | KeywordNone
+    | KeywordNull
+    | KeywordOmitDefault
+    | KeywordPrefix
+    | KeywordPreserve
+    | KeywordPropagate
+    | KeywordProtected
+    | KeywordRequireAll
+    | KeywordReverse
+    | KeywordSet
+    | KeywordType
+    | KeywordValue
+    | KeywordVersion
+    | KeywordVocab
+    deriving (Eq, Ord)
+
+instance Show Keyword where
+    show = \case
+        KeywordAny -> "@any"
+        KeywordBase -> "@base"
+        KeywordContainer -> "@container"
+        KeywordContext -> "@context"
+        KeywordDefault -> "@default"
+        KeywordDirection -> "@direction"
+        KeywordEmbed -> "@embed"
+        KeywordExplicit -> "@explicit"
+        KeywordFirst -> "@first"
+        KeywordGraph -> "@graph"
+        KeywordId -> "@id"
+        KeywordImport -> "@import"
+        KeywordIncluded -> "@included"
+        KeywordIndex -> "@index"
+        KeywordJson -> "@json"
+        KeywordLanguage -> "@language"
+        KeywordList -> "@list"
+        KeywordNest -> "@nest"
+        KeywordNone -> "@none"
+        KeywordNull -> "@null"
+        KeywordOmitDefault -> "@omitDefault"
+        KeywordPrefix -> "@prefix"
+        KeywordPreserve -> "@preserve"
+        KeywordPropagate -> "@propagate"
+        KeywordProtected -> "@protected"
+        KeywordRequireAll -> "@requireAll"
+        KeywordReverse -> "@reverse"
+        KeywordSet -> "@set"
+        KeywordType -> "@type"
+        KeywordValue -> "@value"
+        KeywordVersion -> "@version"
+        KeywordVocab -> "@vocab"
+
+parseKeyword :: Text -> Maybe Keyword
+parseKeyword = \case
+    "@any" -> Just KeywordAny
+    "@base" -> Just KeywordBase
+    "@container" -> Just KeywordContainer
+    "@context" -> Just KeywordContext
+    "@default" -> Just KeywordDefault
+    "@direction" -> Just KeywordDirection
+    "@embed" -> Just KeywordEmbed
+    "@explicit" -> Just KeywordExplicit
+    "@first" -> Just KeywordFirst
+    "@graph" -> Just KeywordGraph
+    "@id" -> Just KeywordId
+    "@import" -> Just KeywordImport
+    "@included" -> Just KeywordIncluded
+    "@index" -> Just KeywordIndex
+    "@json" -> Just KeywordJson
+    "@language" -> Just KeywordLanguage
+    "@list" -> Just KeywordList
+    "@nest" -> Just KeywordNest
+    "@none" -> Just KeywordNone
+    "@null" -> Just KeywordNull
+    "@omitDefault" -> Just KeywordOmitDefault
+    "@prefix" -> Just KeywordPrefix
+    "@preserve" -> Just KeywordPreserve
+    "@propagate" -> Just KeywordPropagate
+    "@protected" -> Just KeywordProtected
+    "@requireAll" -> Just KeywordRequireAll
+    "@reverse" -> Just KeywordReverse
+    "@set" -> Just KeywordSet
+    "@type" -> Just KeywordType
+    "@value" -> Just KeywordValue
+    "@version" -> Just KeywordVersion
+    "@vocab" -> Just KeywordVocab
+    _ -> Nothing
+
+isKeyword :: Foldable f => Text -> f Keyword -> Bool
+isKeyword (parseKeyword -> Just keyword) (F.elem keyword -> True) = True
+isKeyword _ _ = False
+
+isNotKeyword :: Foldable f => Text -> f Keyword -> Bool
+isNotKeyword s = isKeyword s .> not
+
+allKeywords :: Foldable f => f Text -> f Keyword -> Bool
+allKeywords values keywords = all (`isKeyword` keywords) values
+
+isKeywordLike :: Text -> Bool
+isKeywordLike (T.uncons -> Just ('@', res)) = not (T.null res) && T.all isAlpha res
+isKeywordLike _ = False