summaryrefslogtreecommitdiff
path: root/tests/Test/StarWars/Data.hs
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2020-11-05 07:55:22 +0100
committerEugen Wissner <belka@caraus.de>2020-11-05 07:55:22 +0100
commit7f0fb187169938f7b9b2333b5cc79293813c0eb1 (patch)
tree8c0419592dc7619b040c57c86dc13b52c10f5bd0 /tests/Test/StarWars/Data.hs
parentafcf9aaa14e925ca137ec956e3bfd47d2506c904 (diff)
downloadgraphql-7f0fb187169938f7b9b2333b5cc79293813c0eb1.tar.gz
Remove StarWars tests
Our own test suite is slowly getting sufficient.
Diffstat (limited to 'tests/Test/StarWars/Data.hs')
-rw-r--r--tests/Test/StarWars/Data.hs204
1 files changed, 0 insertions, 204 deletions
diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs
deleted file mode 100644
index e3dd696..0000000
--- a/tests/Test/StarWars/Data.hs
+++ /dev/null
@@ -1,204 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-module Test.StarWars.Data
- ( Character
- , StarWarsException(..)
- , appearsIn
- , artoo
- , getDroid
- , getDroid'
- , getEpisode
- , getFriends
- , getHero
- , getHuman
- , id_
- , homePlanet
- , name_
- , secretBackstory
- , typeName
- ) where
-
-import Control.Monad.Catch (Exception(..), MonadThrow(..), SomeException)
-import Control.Applicative (Alternative(..), liftA2)
-import Data.Maybe (catMaybes)
-import Data.Text (Text)
-import Data.Typeable (cast)
-import Language.GraphQL.Error
-import Language.GraphQL.Type
-
--- * Data
--- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
-
--- ** Characters
-
-type ID = Text
-
-data CharCommon = CharCommon
- { _id_ :: ID
- , _name :: Text
- , _friends :: [ID]
- , _appearsIn :: [Int]
- } deriving (Show)
-
-
-data Human = Human
- { _humanChar :: CharCommon
- , homePlanet :: Text
- }
-
-data Droid = Droid
- { _droidChar :: CharCommon
- , primaryFunction :: Text
- }
-
-type Character = Either Droid Human
-
-id_ :: Character -> ID
-id_ (Left x) = _id_ . _droidChar $ x
-id_ (Right x) = _id_ . _humanChar $ x
-
-name_ :: Character -> Text
-name_ (Left x) = _name . _droidChar $ x
-name_ (Right x) = _name . _humanChar $ x
-
-friends :: Character -> [ID]
-friends (Left x) = _friends . _droidChar $ x
-friends (Right x) = _friends . _humanChar $ x
-
-appearsIn :: Character -> [Int]
-appearsIn (Left x) = _appearsIn . _droidChar $ x
-appearsIn (Right x) = _appearsIn . _humanChar $ x
-
-data StarWarsException = SecretBackstory | InvalidArguments
-
-instance Show StarWarsException where
- show SecretBackstory = "secretBackstory is secret."
- show InvalidArguments = "Invalid arguments."
-
-instance Exception StarWarsException where
- toException = toException . ResolverException
- fromException e = do
- ResolverException resolverException <- fromException e
- cast resolverException
-
-secretBackstory :: Resolve (Either SomeException)
-secretBackstory = throwM SecretBackstory
-
-typeName :: Character -> Text
-typeName = either (const "Droid") (const "Human")
-
-luke :: Character
-luke = Right luke'
-
-luke' :: Human
-luke' = Human
- { _humanChar = CharCommon
- { _id_ = "1000"
- , _name = "Luke Skywalker"
- , _friends = ["1002","1003","2000","2001"]
- , _appearsIn = [4,5,6]
- }
- , homePlanet = "Tatooine"
- }
-
-vader :: Human
-vader = Human
- { _humanChar = CharCommon
- { _id_ = "1001"
- , _name = "Darth Vader"
- , _friends = ["1004"]
- , _appearsIn = [4,5,6]
- }
- , homePlanet = "Tatooine"
- }
-
-han :: Human
-han = Human
- { _humanChar = CharCommon
- { _id_ = "1002"
- , _name = "Han Solo"
- , _friends = ["1000","1003","2001" ]
- , _appearsIn = [4,5,6]
- }
- , homePlanet = mempty
- }
-
-leia :: Human
-leia = Human
- { _humanChar = CharCommon
- { _id_ = "1003"
- , _name = "Leia Organa"
- , _friends = ["1000","1002","2000","2001"]
- , _appearsIn = [4,5,6]
- }
- , homePlanet = "Alderaan"
- }
-
-tarkin :: Human
-tarkin = Human
- { _humanChar = CharCommon
- { _id_ = "1004"
- , _name = "Wilhuff Tarkin"
- , _friends = ["1001"]
- , _appearsIn = [4]
- }
- , homePlanet = mempty
- }
-
-threepio :: Droid
-threepio = Droid
- { _droidChar = CharCommon
- { _id_ = "2000"
- , _name = "C-3PO"
- , _friends = ["1000","1002","1003","2001" ]
- , _appearsIn = [ 4, 5, 6 ]
- }
- , primaryFunction = "Protocol"
- }
-
-artoo :: Character
-artoo = Left artoo'
-
-artoo' :: Droid
-artoo' = Droid
- { _droidChar = CharCommon
- { _id_ = "2001"
- , _name = "R2-D2"
- , _friends = ["1000","1002","1003"]
- , _appearsIn = [4,5,6]
- }
- , primaryFunction = "Astrometch"
- }
-
--- ** Helper functions
-
-getHero :: Int -> Character
-getHero 5 = luke
-getHero _ = artoo
-
-getHuman :: ID -> Maybe Character
-getHuman = fmap Right . getHuman'
-
-getHuman' :: ID -> Maybe Human
-getHuman' "1000" = pure luke'
-getHuman' "1001" = pure vader
-getHuman' "1002" = pure han
-getHuman' "1003" = pure leia
-getHuman' "1004" = pure tarkin
-getHuman' _ = empty
-
-getDroid :: ID -> Maybe Character
-getDroid = fmap Left . getDroid'
-
-getDroid' :: ID -> Maybe Droid
-getDroid' "2000" = pure threepio
-getDroid' "2001" = pure artoo'
-getDroid' _ = empty
-
-getFriends :: Character -> [Character]
-getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
-
-getEpisode :: Int -> Maybe Text
-getEpisode 4 = pure "NEW_HOPE"
-getEpisode 5 = pure "EMPIRE"
-getEpisode 6 = pure "JEDI"
-getEpisode _ = empty