morpheus-graphql-core-0.13.0: test/Lib.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Lib
  ( getGQLBody,
    getResponseBody,
    getCases,
    maybeVariables,
    readSource,
    scanSchemaTests,
    FileUrl (..),
    CaseTree (..),
    toString,
  )
where

import Control.Applicative ((<|>))
import Data.Aeson (FromJSON, Value (..), decode)
import qualified Data.ByteString.Lazy as L (readFile)
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.Maybe (fromMaybe)
import Data.Morpheus.Types.Internal.AST (FieldName (..))
import Data.Semigroup ((<>))
import Data.Text (Text, unpack)
import System.Directory (doesDirectoryExist, listDirectory)

readSource :: FieldName -> IO ByteString
readSource = L.readFile . path . readName

path :: Text -> String
path name = "test/" ++ unpack name

gqlLib :: Text -> String
gqlLib x = path x ++ "/query.gql"

resLib :: Text -> String
resLib x = path x ++ "/response.json"

data FileUrl = FileUrl
  { filePath :: [FilePath],
    fileName :: FilePath
  }
  deriving (Show)

data CaseTree = CaseTree
  { caseUrl :: FileUrl,
    children :: Either [String] [CaseTree]
  }
  deriving (Show)

prefix :: FileUrl -> FilePath -> FileUrl
prefix FileUrl {..} x =
  FileUrl
    { filePath = fileName : filePath,
      fileName = x
    }

toString :: FileUrl -> FilePath
toString FileUrl {..} = foldl (\y x -> x <> "/" <> y) fileName filePath

scanSchemaTests :: FilePath -> IO CaseTree
scanSchemaTests = deepScan

deepScan :: FilePath -> IO CaseTree
deepScan = shouldScan . FileUrl []
  where
    shouldScan :: FileUrl -> IO CaseTree
    shouldScan caseUrl@FileUrl {..} = do
      children <- prefixed caseUrl
      pure CaseTree {..}
    isDirectory :: FileUrl -> IO Bool
    isDirectory = doesDirectoryExist . toString
    prefixed :: FileUrl -> IO (Either [String] [CaseTree])
    prefixed p = do
      dir <- isDirectory p
      if dir
        then do
          list <- map (prefix p) <$> listDirectory (toString p)
          areDirectories <- traverse isDirectory list
          if and areDirectories
            then Right <$> traverse shouldScan list
            else pure $ Left []
        else pure $ Left []

maybeVariables :: FieldName -> IO (Maybe Value)
maybeVariables (FieldName x) = decode <$> (L.readFile (path x ++ "/variables.json") <|> return "{}")

getGQLBody :: FieldName -> IO ByteString
getGQLBody (FieldName p) = L.readFile (gqlLib p)

getCases :: FromJSON a => String -> IO [a]
getCases dir = fromMaybe [] . decode <$> L.readFile ("test/" ++ dir ++ "/cases.json")

getResponseBody :: FieldName -> IO Value
getResponseBody (FieldName p) = fromMaybe Null . decode <$> L.readFile (resLib p)