module Telescope.Asdf.Reference where

import Data.List ((!?))
import Data.Text (Text)
import Effectful
import Telescope.Asdf.NDArray
import Telescope.Asdf.Node
import Telescope.Data.Parser


-- resolveInternalPointer :: forall a es. (FromAsdf a, Reader Tree :> es, Parser :> es) => JSONPointer -> Eff es a
-- resolveInternalPointer point = do
--   Node _ value <- findPointer point
--   parseValue value

-- | Parse a 'JSONPointer' from a 'Tree'
findPointer :: forall es. (Parser :> es) => JSONPointer -> Tree -> Eff es Node
findPointer :: forall (es :: [Effect]).
(Parser :> es) =>
JSONPointer -> Tree -> Eff es Node
findPointer (JSONPointer Path
path) (Tree Object
tree) = do
  Path -> Node -> Eff es Node
parseNext Path
path (SchemaTag -> Maybe Anchor -> Value -> Node
Node SchemaTag
forall a. Monoid a => a
mempty Maybe Anchor
forall a. Maybe a
Nothing (Object -> Value
Object Object
tree))
 where
  parseNext :: Path -> Node -> Eff es Node
  parseNext :: Path -> Node -> Eff es Node
parseNext (Path []) Node
node = Node -> Eff es Node
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
node
  parseNext (Path (Ref
p : [Ref]
ps)) (Node SchemaTag
_ Maybe Anchor
_ Value
val) = do
    Node
child <- Ref -> Value -> Eff es Node
parseSegment Ref
p Value
val
    Path -> Node -> Eff es Node
parseNext ([Ref] -> Path
Path [Ref]
ps) Node
child

  parseSegment :: Ref -> Value -> Eff es Node
  parseSegment :: Ref -> Value -> Eff es Node
parseSegment (Child Text
n) (Object Object
o) = Text -> Object -> Eff es Node
parseChild Text
n Object
o
  parseSegment (Child Text
n) Value
node = Ref -> Value -> Eff es Node
forall ex at. (Show ex, Show at) => ex -> at -> Eff es Node
missingPointer (Text -> Ref
Child Text
n) Value
node
  parseSegment (Index Int
n) (Array [Node]
a) = Int -> [Node] -> Eff es Node
parseIndex Int
n [Node]
a
  parseSegment (Index Int
n) Value
node = Ref -> Value -> Eff es Node
forall ex at. (Show ex, Show at) => ex -> at -> Eff es Node
missingPointer (Int -> Ref
Index Int
n) Value
node

  parseChild :: Text -> Object -> Eff es Node
  parseChild :: Text -> Object -> Eff es Node
parseChild Text
name Object
o =
    case Text -> Object -> Maybe Node
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
name Object
o of
      Maybe Node
Nothing -> Ref -> Object -> Eff es Node
forall ex at. (Show ex, Show at) => ex -> at -> Eff es Node
missingPointer (Text -> Ref
Child Text
name) Object
o
      Just Node
c -> Node -> Eff es Node
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
c

  parseIndex :: Int -> [Node] -> Eff es Node
  parseIndex :: Int -> [Node] -> Eff es Node
parseIndex Int
n [Node]
a =
    case [Node]
a [Node] -> Int -> Maybe Node
forall a. [a] -> Int -> Maybe a
!? Int
n of
      Maybe Node
Nothing -> Ref -> [Node] -> Eff es Node
forall ex at. (Show ex, Show at) => ex -> at -> Eff es Node
missingPointer (Int -> Ref
Index Int
n) [Node]
a
      Just Node
c -> Node -> Eff es Node
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Node
c

  missingPointer :: (Show ex, Show at) => ex -> at -> Eff es Node
  missingPointer :: forall ex at. (Show ex, Show at) => ex -> at -> Eff es Node
missingPointer ex
expect at
at = [Char] -> Eff es Node
forall (es :: [Effect]) a. (Parser :> es) => [Char] -> Eff es a
parseFail ([Char] -> Eff es Node) -> [Char] -> Eff es Node
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not locate pointer: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Path -> [Char]
forall a. Show a => a -> [Char]
show Path
path [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
". Expected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ex -> [Char]
forall a. Show a => a -> [Char]
show ex
expect [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ at -> [Char]
forall a. Show a => a -> [Char]
show at
at