module Data.JsonSchema.Reference where
import qualified Data.HashMap.Strict as H
import Data.JsonPointer
import qualified Data.Text as T
import Data.Text.Encoding
import Network.HTTP.Types.URI
import Import
type URIBase = Maybe Text
type URIBaseAndFragment = (Maybe Text, Maybe Text)
newResolutionScope :: URIBase -> HashMap Text Value -> URIBase
newResolutionScope mScope o =
case H.lookup "id" o of
Just (String t) -> fst . baseAndFragment $ resolveScopeAgainst mScope t
_ -> mScope
resolveReference :: URIBase -> Text -> URIBaseAndFragment
resolveReference mScope t = baseAndFragment $ resolveScopeAgainst mScope t
isRemoteReference :: Text -> Bool
isRemoteReference uri = "://" `T.isInfixOf` uri
resolveFragment :: Maybe Text -> HashMap Text Value -> HashMap Text Value
resolveFragment Nothing hm = hm
resolveFragment (Just pointer) hm =
let urlDecoded = decodeUtf8 . urlDecode True . encodeUtf8 $ pointer
in case jsonPointer urlDecoded of
Left _ -> hm
Right p ->
case resolvePointer p (Object hm) of
Right (Object hm') -> hm'
_ -> hm
baseAndFragment :: Text -> URIBaseAndFragment
baseAndFragment = f . T.splitOn "#"
where
f :: [Text] -> URIBaseAndFragment
f [x] = (g x, Nothing)
f [x,y] = (g x, g y)
f _ = (Nothing, Nothing)
g "" = Nothing
g x = Just x
resolveScopeAgainst :: Maybe Text -> Text -> Text
resolveScopeAgainst Nothing t = t
resolveScopeAgainst (Just scope) t
| isRemoteReference t = t
| otherwise = smartAppend
where
smartAppend :: Text
smartAppend = case baseAndFragment scope of
(Just base,_) -> base <> t
_ -> t