module JSONSchema.Validator.Reference where
import Import
import qualified Data.Text as T
import System.FilePath ((</>), dropFileName)
data Scope schema = Scope
{ _topLevelDocument :: schema
, _documentURI :: Maybe Text
, _currentBaseURI :: BaseURI
} deriving (Eq, Show)
newtype BaseURI
= BaseURI { _unBaseURI :: Maybe Text }
deriving (Eq, Show)
type URIAndFragment = (Maybe Text, Maybe Text)
updateResolutionScope :: BaseURI -> Maybe Text -> BaseURI
updateResolutionScope base idKeyword
| Just t <- idKeyword = BaseURI . fst . baseAndFragment $ resolveScopeAgainst base t
| otherwise = base
resolveReference :: BaseURI -> Text -> URIAndFragment
resolveReference base t = baseAndFragment (resolveScopeAgainst base t)
isRemoteReference :: Text -> Bool
isRemoteReference = T.isInfixOf "://"
baseAndFragment :: Text -> URIAndFragment
baseAndFragment = f . T.splitOn "#"
where
f :: [Text] -> URIAndFragment
f [x] = (g x, Nothing)
f [x,y] = (g x, g y)
f _ = (Nothing, Nothing)
g "" = Nothing
g x = Just x
resolveScopeAgainst :: BaseURI -> Text -> Text
resolveScopeAgainst (BaseURI Nothing) t = t
resolveScopeAgainst (BaseURI (Just base)) t
| isRemoteReference t = t
| otherwise = smartAppend
where
smartAppend :: Text
smartAppend =
case baseAndFragment base of
(Just uri,_) ->
case T.unpack t of
'#':_ -> base <> t
_ -> T.pack (dropFileName (T.unpack uri) </> T.unpack t)
_ -> t