module Data.JsonSchema.Reference where
import Control.Arrow
import Control.Exception
import Control.Monad
import Data.Aeson
import Data.ByteString.Lazy (ByteString)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import Network.HTTP.Conduit
import Prelude hiding (foldr)
combineIdAndRef :: Text -> Text -> Text
combineIdAndRef a b
| "://" `T.isInfixOf` b = b
| T.length a < 1 || T.length b < 1 = a <> b
| T.last a == '#' && T.head b == '#' = a <> T.tail b
| otherwise = a <> b
combineIds :: Text -> Text -> Text
combineIds a b
| b == "#" || b == "" = a
| "://" `T.isInfixOf` b = b
| T.length a < 1 || T.length b < 1 = a <> b
| T.last a == '#' && T.head b == '#' = a <> T.tail b
| otherwise = a <> b
newResolutionScope :: Text -> HashMap Text Value -> Text
newResolutionScope t o =
case H.lookup "id" o of
Just (String idKeyword) -> t `combineIds` idKeyword
_ -> t
refAndPointer :: Text -> Maybe (Text, Text)
refAndPointer val = getParts $ T.splitOn "#" val
where
getParts :: [Text] -> Maybe (Text, Text)
getParts [] = Just ("","")
getParts [x] = Just (x,"")
getParts [x,y] = Just (x,y)
getParts _ = Nothing
fetchRef :: Text -> IO (Either Text (HashMap Text Value))
fetchRef t = do
eResp <- safeGet t
case eResp of
Left e -> return $ Left e
Right b -> return . left T.pack $ eitherDecode b
safeGet :: Text -> IO (Either Text ByteString)
safeGet url =
catch
(return . Right =<< (simpleHttp . T.unpack) url)
handler
where
handler :: SomeException -> IO (Either Text ByteString)
handler e = return . Left . T.pack . show $ e