Reference.hs

module Data.JsonSchema.Reference where

import           Control.Exception
import           Control.Lens
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.Wreq
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 err -> return (Left err)
    Right b  ->
      case eitherDecode b of
        Right (Object z) -> return (Right z)
        Right v          -> return . Left $
          "fetchRef returned the following instead of an object" <> T.pack (show v)
        Left e           -> return . Left . T.pack $ e

safeGet :: Text -> IO (Either Text ByteString)
safeGet url =
  catch
    (return . Right . (^. responseBody) =<< get (T.unpack url))
    handler
  where
    handler :: SomeException -> IO (Either Text ByteString)
    handler e = return . Left . T.pack . show $ e