packages feed

morpheus-graphql-tests (empty) → 0.18.0

raw patch · 5 files changed

+520/−0 lines, 5 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, directory, relude, tasty, tasty-hunit, text, unordered-containers

Files

+ morpheus-graphql-tests.cabal view
@@ -0,0 +1,46 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack+--+-- hash: 0ac9343524efdc7c2418af23f1cb455e747ee3ef33da99c7650debf131f39e92++name:           morpheus-graphql-tests+version:        0.18.0+synopsis:       Morpheus GraphQL Test+category:       web, graphql, test+homepage:       https://morpheusgraphql.com+bug-reports:    https://github.com/nalchevanidze/morpheus-graphql/issues+author:         Daviti Nalchevanidze+maintainer:     d.nalchevanidze@gmail.com+copyright:      (c) 2019 Daviti Nalchevanidze+license:        MIT+build-type:     Simple++source-repository head+  type: git+  location: https://github.com/nalchevanidze/morpheus-graphql++library+  exposed-modules:+      Test.Morpheus+  other-modules:+      Test.Morpheus.File+      Test.Morpheus.Response+      Test.Morpheus.Utils+      Paths_morpheus_graphql_tests+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      aeson+    , base >=4.7 && <5+    , bytestring >=0.10.4 && <0.11+    , directory >=1.0+    , relude >=0.3.0+    , tasty+    , tasty-hunit+    , text >=1.2.3.0 && <1.3+    , unordered-containers+  default-language: Haskell2010
+ src/Test/Morpheus.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Test.Morpheus+  ( FileUrl,+    mkUrl,+    cd,+    file,+    deepScan,+    scan,+    -- get app+    getAppsBy,+    -- tests+    testApi,+    testSchema,+    testQueryRendering,+    renderingAssertion,+    testQuery,+    testQueryValidation,+    -- main+    mainTest,+  )+where++import Data.Aeson+  ( FromJSON (..),+    ToJSON (..),+    encode,+  )+import Data.ByteString.Lazy.Char8 (ByteString)+import Relude hiding (ByteString)+import Test.Morpheus.File+import Test.Morpheus.Response+import Test.Morpheus.Utils+import Test.Tasty+  ( TestTree,+    defaultMain,+    testGroup,+  )+import Test.Tasty.HUnit+  ( assertFailure,+    testCase,+  )++mainTest :: String -> [IO TestTree] -> IO ()+mainTest name xs = do+  tests <- sequence xs+  defaultMain $+    testGroup+      name+      tests++--+testApi ::+  (FromJSON req, ToJSON res) =>+  (req -> IO res) ->+  FileUrl ->+  TestTree+testApi api =+  assertResponse+    (fmap expects . api <=< getQuery)++testQuery ::+  (FromJSON req, ToJSON err, Eq err, FromJSON err) =>+  (req -> Either err a) ->+  FileUrl ->+  TestTree+testQuery f =+  assertResponse+    (fmap (fromEither . f) . getQuery)++testSchema ::+  (ToJSON err, Eq err, FromJSON err) =>+  (ByteString -> Either err a) ->+  FileUrl ->+  TestTree+testSchema f =+  assertResponse+    (fmap (fromEither . f) . readSchemaFile)++renderingAssertion ::+  (ToJSON e) =>+  (FileUrl -> IO (Either e ByteString)) ->+  FileUrl ->+  TestTree+renderingAssertion api url = testCase (fileName url) $ do+  actual <- api url+  expected <- readGQL "rendering" url+  either+    (assertFailure . (" error: " <>) . show . encode)+    (requireEq id expected)+    actual++getAppBy ::+  (Show err, FromJSON resolvers) =>+  ( ByteString -> Either err schema,+    schema -> resolvers -> app+  ) ->+  FileUrl ->+  IO app+getAppBy (parseSchema, mkApp) url =+  mkApp+    <$> getSchema parseSchema url+    <*> getResolver url++testQueryValidation ::+  ( ToJSON errors,+    Show errors,+    FromJSON request,+    FromJSON errors,+    Eq errors+  ) =>+  ( schema -> request -> Either errors a,+    ByteString -> Either errors schema+  ) ->+  FileUrl ->+  FileUrl ->+  TestTree+testQueryValidation (parseRequest, parseSchema) schemaUrl =+  assertResponse+    ( \url -> do+        schema <- getSchema parseSchema schemaUrl+        query <- getQuery url+        pure $ fromEither (parseRequest schema query)+    )++testQueryRendering ::+  ( ToJSON errors,+    Show errors,+    FromJSON request+  ) =>+  ( schema -> request -> Either errors ByteString,+    ByteString -> Either errors schema+  ) ->+  FileUrl ->+  FileUrl ->+  TestTree+testQueryRendering (parseRequest, parseSchema) schemaUrl =+  renderingAssertion+    ( \requestUrl -> do+        request <- getQuery requestUrl+        schema <- getSchema parseSchema schemaUrl+        pure $ parseRequest schema request+    )++getAppsWIth ::+  (Semigroup b, Show err, FromJSON resolvers) =>+  ( ByteString -> Either err schema,+    schema -> resolvers -> b+  ) ->+  FileUrl ->+  [FilePath] ->+  IO b+getAppsWIth f url [] = getAppBy f url+getAppsWIth f url (x : xs) = sconcat <$> traverse (getAppBy f) (file url <$> (x :| xs))++getAppsBy ::+  (Semigroup b, Show err, FromJSON resolvers) =>+  ( ByteString -> Either err schema,+    schema -> resolvers -> b+  ) ->+  FileUrl ->+  IO b+getAppsBy f url = do+  files <- searchAppFiles url+  getAppsWIth f url files
+ src/Test/Morpheus/File.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Test.Morpheus.File+  ( withSource,+    ReadSource,+    cd,+    file,+    readJSON,+    readGQL,+    FileUrl (..),+    ls,+    mkUrl,+    isDirectory,+    scanDirectories,+    searchAppFiles,+  )+where++import qualified Data.ByteString.Lazy.Char8 as L+import Data.ByteString.Lazy.Char8 (ByteString)+import Data.List+import qualified Data.Text.IO as T+import Relude hiding (ByteString)+import System.Directory (doesDirectoryExist, listDirectory)++class ReadSource t where+  readSource :: ToString name => name -> IO t++instance ReadSource Text where+  readSource = T.readFile . toString++instance ReadSource ByteString where+  readSource = L.readFile . toString++withSource :: ReadSource t => (String, String) -> FileUrl -> IO t+withSource (name, format) url+  | isDir url = readSource $ toString url <> "/" <> name <> "." <> format+  | otherwise = readSource $ toString url <> "." <> format++readGQL :: ReadSource t => String -> FileUrl -> IO t+readGQL x = withSource (x, "gql")++readJSON :: ReadSource t => String -> FileUrl -> IO t+readJSON x = withSource (x, "json")++data FileUrl = FileUrl+  { filePath :: [FilePath],+    fileName :: FilePath,+    isDir :: Bool+  }+  deriving (Show)++instance ToString FileUrl where+  toString FileUrl {..} = foldl' (\y x -> x <> "/" <> y) fileName filePath++goTo :: FileUrl -> FilePath -> Bool -> FileUrl+goTo FileUrl {fileName, filePath} name isDir =+  FileUrl+    { filePath = fileName : filePath,+      fileName = name,+      ..+    }++cd :: FileUrl -> FilePath -> FileUrl+cd url name = goTo url name True++file :: FileUrl -> FilePath -> FileUrl+file url name = goTo url name False++ls :: FileUrl -> IO [FileUrl]+ls url = do+  files <- listDirectory (toString url)+  traverse mkFile files+  where+    mkFile name =+      goTo url name+        <$> doesDirectoryExist+          (toString url <> "/" <> name)++isDirectory :: FileUrl -> IO Bool+isDirectory = doesDirectoryExist . toString++mkUrl :: FilePath -> FileUrl+mkUrl fileName =+  FileUrl+    { filePath = ["test"],+      fileName,+      isDir = True+    }++scanDirectories :: FileUrl -> IO [FileUrl]+scanDirectories = fmap (filter isDir) . ls++searchAppFiles :: FileUrl -> IO [FilePath]+searchAppFiles = fmap (nub . mapMaybe isAppFile) . ls+  where+    isAppFile FileUrl {fileName, isDir}+      | not isDir+          && "app-" `isPrefixOf` fileName =+        Just $ takeWhile (/= '.') fileName+      | otherwise = Nothing
+ src/Test/Morpheus/Response.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Test.Morpheus.Response+  ( assertResponse,+    getQuery,+    fromEither,+    expects,+  )+where++import Data.Aeson+  ( (.=),+    FromJSON (..),+    Result (..),+    ToJSON (..),+    Value (..),+    decode,+    eitherDecode,+    encode,+    fromJSON,+    object,+  )+import Relude hiding (ByteString)+import Test.Morpheus.File (FileUrl (fileName), readGQL, readJSON)+import Test.Morpheus.Utils (requireEq)+import Test.Tasty+  ( TestTree,+  )+import Test.Tasty.HUnit+  ( testCase,+  )++data CaseAssertion a+  = OK+  | Expected a+  deriving (Generic, Eq)++instance FromJSON a => FromJSON (CaseAssertion a) where+  parseJSON (String "OK") = pure OK+  parseJSON v = Expected <$> parseJSON v++instance ToJSON a => ToJSON (CaseAssertion a) where+  toJSON OK = String "OK"+  toJSON (Expected v) = toJSON v++getResponse :: FromJSON a => FileUrl -> IO (CaseAssertion a)+getResponse = readJSON "response" >=> either fail pure . eitherDecode++assertResponse ::+  (FromJSON a, Eq a, ToJSON a) =>+  (FileUrl -> IO (CaseAssertion a)) ->+  FileUrl ->+  TestTree+assertResponse f url = testCase (fileName url) $ do+  actual <- f url+  expected <- getResponse url+  requireEq encode expected actual++runResult :: Result a -> IO a+runResult (Success x) = pure x+runResult (Error x) = fail x++getQuery :: (FromJSON req) => FileUrl -> IO req+getQuery url = do+  query <- String <$> readGQL "query" url+  variables <- decode <$> readJSON "variables" url <|> pure Nothing+  mkQuery query variables++mkQuery :: (FromJSON a) => Value -> Maybe Value -> IO a+mkQuery query variables =+  runResult $ fromJSON $+    object+      [ "query" .= query,+        "variables" .= variables+      ]++fromEither :: ToJSON err => Either err a -> CaseAssertion err+fromEither (Left err) = Expected err+fromEither Right {} = OK++expects :: ToJSON a => a -> CaseAssertion Value+expects = Expected . toJSON
+ src/Test/Morpheus/Utils.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Test.Morpheus.Utils+  ( FileUrl,+    deepScan,+    scan,+    getResolver,+    getSchema,+    requireEq,+    readSchemaFile,+  )+where++import Data.Aeson+  ( FromJSON (..),+    eitherDecode,+  )+import qualified Data.ByteString.Lazy.Char8 as L+import Data.ByteString.Lazy.Char8 (ByteString)+import Relude hiding (ByteString)+import Test.Morpheus.File+import Test.Tasty+  ( TestTree,+    testGroup,+  )+import Test.Tasty.HUnit+  ( assertFailure,+  )++readSchemaFile :: ReadSource t => FileUrl -> IO t+readSchemaFile = readGQL "schema"++runCaseTree :: (FileUrl -> [FileUrl] -> [TestTree]) -> CaseTree [FileUrl] -> TestTree+runCaseTree f CaseTree {caseUrl, children = [], assets} =+  testGroup (fileName caseUrl) (f caseUrl assets)+runCaseTree f CaseTree {caseUrl = FileUrl {fileName}, children} =+  testGroup fileName (fmap (runCaseTree f) children)++foldCaseTree :: (FileUrl -> TestTree) -> CaseTree () -> TestTree+foldCaseTree f CaseTree {caseUrl, children = []} = f caseUrl+foldCaseTree f CaseTree {caseUrl = FileUrl {fileName}, children} =+  testGroup fileName (fmap (foldCaseTree f) children)++recursiveScan :: Monoid assets => (FileUrl -> IO assets) -> FileUrl -> IO (CaseTree assets)+recursiveScan scanAssets caseUrl = do+  dir <- isDirectory caseUrl+  children <-+    if dir+      then do+        list <- ls caseUrl+        if all isDir list+          then traverse (recursiveScan scanAssets) list+          else pure []+      else pure []+  assets <- if dir && null children then scanAssets caseUrl else pure mempty+  pure CaseTree {..}++scan :: (FileUrl -> TestTree) -> FileUrl -> IO TestTree+scan f url = foldCaseTree f <$> recursiveScan (const (pure ())) url++deepScan :: (FileUrl -> [FileUrl] -> [TestTree]) -> FileUrl -> IO TestTree+deepScan f url = runCaseTree f <$> recursiveScan scanDirectories url++data CaseTree assets = CaseTree+  { caseUrl :: FileUrl,+    children :: [CaseTree assets],+    assets :: assets+  }+  deriving (Show)++requireEq :: (Eq t) => (t -> ByteString) -> t -> t -> IO ()+requireEq f expected actual+  | expected == actual = pure ()+  | otherwise = eqFailureMessage (f expected) (f actual)++eqFailureMessage :: ByteString -> ByteString -> IO a3+eqFailureMessage expected actual =+  assertFailure+    $ L.unpack+    $ "expected: \n\n "+      <> expected+      <> " \n\n but got: \n\n "+      <> actual++getSchema :: (ReadSource a, Show err) => (a -> Either err b) -> FileUrl -> IO b+getSchema f url =+  readSchemaFile url+    >>= assertValidSchema . f++assertValidSchema :: Show err => Either err a -> IO a+assertValidSchema =+  either+    ( assertFailure+        . ( "unexpected schema validation error: \n "+              <>+          )+        . show+    )+    pure++getResolver :: FromJSON resolver => FileUrl -> IO resolver+getResolver url = readJSON "resolvers" url >>= either fail pure . eitherDecode++-- data Target+--   = Api+--       ( forall req res.+--         (FromJSON req, ToJSON res) =>+--         (req -> IO res)+--       )+--   | Rendering+--       ( forall req err.+--         (ToJSON err, FromJSON req) =>+--         (req -> IO (Either err ByteString))+--       )