From 11d0fb47c292a0ca25a9c377499d2b221d97a5cb Mon Sep 17 00:00:00 2001
From: Volpeon <github@volpeon.ink>
Date: Fri, 26 May 2023 07:40:13 +0200
Subject: Init

---
 src/Data/JLD.hs | 83 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 83 insertions(+)
 create mode 100644 src/Data/JLD.hs

(limited to 'src/Data/JLD.hs')

diff --git a/src/Data/JLD.hs b/src/Data/JLD.hs
new file mode 100644
index 0000000..d60e5a1
--- /dev/null
+++ b/src/Data/JLD.hs
@@ -0,0 +1,83 @@
+module Data.JLD (
+    module Data.JLD.Mime,
+    module Data.JLD.Error,
+    module Data.JLD.Options,
+    JLDExpandParams (..),
+    expand,
+) where
+
+import Data.JLD.Prelude
+
+import Data.JLD.Context (buildActiveContext)
+import Data.JLD.Control.Monad.RES (evalREST, runREST)
+import Data.JLD.Error
+import Data.JLD.Expansion (JLDEParams (..))
+import Data.JLD.Expansion qualified as E (expand)
+import Data.JLD.Mime
+import Data.JLD.Model.ActiveContext (ActiveContext (..), newActiveContext)
+import Data.JLD.Model.Keyword (Keyword (..))
+import Data.JLD.Model.URI (uriToIri)
+import Data.JLD.Monad (JLDEnv, JLDState, newEnv, newState)
+import Data.JLD.Options
+import Data.JLD.Util (flattenSingletonArray, valueToArray)
+
+import Data.Aeson (Value (..))
+import Data.Aeson.KeyMap qualified as KM
+import Data.Vector qualified as V (singleton)
+import Text.URI (URI)
+
+data JLDExpandParams e m = JLDExpandParams
+    { jldExpandParamsExpandContext :: Maybe Value
+    , jldExpandParamsFrameExpansion :: Bool
+    , jldExpandParamsEnv :: JLDEnv e m
+    , jldExpandParamsState :: JLDState
+    }
+    deriving (Show)
+
+expand :: Monad m => Value -> URI -> (JLDExpandParams () m -> JLDExpandParams e m) -> m (Either (JLDError e) Value, JLDState)
+expand document baseUrl paramsFn = do
+    let JLDExpandParams{..} =
+            paramsFn
+                JLDExpandParams
+                    { jldExpandParamsExpandContext = Nothing
+                    , jldExpandParamsFrameExpansion = False
+                    , jldExpandParamsEnv = newEnv id
+                    , jldExpandParamsState = newState id
+                    }
+
+        activeContext = newActiveContext \ac -> ac{activeContextBaseUrl = Just baseUrl, activeContextBaseIri = uriToIri baseUrl}
+        expansionParams p = p{jldeParamsFrameExpansion = jldExpandParamsFrameExpansion}
+
+    -- 6.
+    let maybeExpandContext =
+            jldExpandParamsExpandContext <&> flattenSingletonArray .> \case
+                Array expandedContext -> Array expandedContext
+                (Object expandedContext) | Just ctx <- KM.lookup (show KeywordContext) expandedContext -> ctx
+                expandedContext -> Array <| V.singleton expandedContext
+
+    activeContext' <- case maybeExpandContext of
+        Just expandContext ->
+            buildActiveContext activeContext expandContext (Just baseUrl) id
+                |> evalREST jldExpandParamsEnv jldExpandParamsState
+                |> fmap (fromRight activeContext)
+        Nothing -> pure activeContext
+
+    -- 8.
+    (result, state') <-
+        E.expand activeContext' document baseUrl expansionParams
+            |> runREST jldExpandParamsEnv jldExpandParamsState
+
+    let result' = case result of
+            -- 8.1.
+            Right (Object expanded)
+                | KM.size expanded == 1
+                , Just expanded' <- KM.lookup (show KeywordGraph) expanded ->
+                    Right <. Array <| valueToArray expanded'
+            -- 8.2.
+            Right Null -> Right <| Array mempty
+            -- 8.3.
+            Right expanded -> Right <. Array <| valueToArray expanded
+            --
+            Left err -> Left err
+
+    pure (result', state')
-- 
cgit v1.2.3-54-g00ecf