prescientmoon/graphql
1
0
Fork 0
forked from OSS/graphql
Code Pull Requests Activity

Split Character data type into Droid and Human

Browse Source 
`Character` is now a synonym of the sum type of `Droid` and `Human`.

For now I don't see the need to implement GraphQL Schema interfaces with
type classes or lens. Plain Haskell ADTs should be good enough.
This commit is contained in:
Danny Navarro 2016-02-09 14:38:19 +01:00
parent df8e43c9aa
commit 70fbaf359e
1 changed files with 113 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

175
tests/Test/StarWars.hs
View File

@ -131,7 +131,7 @@ query _ = empty
hero :: Alternative f => Resolver f hero :: Alternative f => Resolver f
hero (InputList (InputScalar (ScalarInt ep) : inputFields)) = hero (InputList (InputScalar (ScalarInt ep) : inputFields)) =
withFields inputFields <$> getHero ep withFields inputFields <$> getHero ep
hero (InputField fld) = characterOutput fld artoo hero (InputField fld) = characterOutput fld $ Left artoo
hero _ = empty hero _ = empty
human :: Alternative f => Resolver f human :: Alternative f => Resolver f
@ -171,98 +171,149 @@ withFields inputFields char =
-- ** Characters -- ** Characters
data Character = Character data CharCommon = CharCommon
{ id_ :: ID { _id_ :: ID
, name :: Text , _name :: Text
, friends :: [ID] , _friends :: [ID]
, appearsIn :: [Int] , _appearsIn :: [Int]
, homePlanet :: Text
} deriving (Show) } deriving (Show)
luke :: Character
luke = Character data Human = Human
{ id_ = "1000" { _humanChar :: CharCommon
, name = "Luke Skywalker" , homePlanet :: Text
, friends = ["1002","1003","2000","2001"] }
, appearsIn = [4,5,6]
data Droid = Droid
{ _droidChar :: CharCommon
, primaryFunction :: Text
}
type Character = Either Droid Human
-- I don't think this is cumbersome enough to make it worth using lens.
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
luke :: Human
luke = Human
{ _humanChar = CharCommon
{ _id_ = "1000"
, _name = "Luke Skywalker"
, _friends = ["1002","1003","2000","2001"]
, _appearsIn = [4,5,6]
}
, homePlanet = "Tatoonie" , homePlanet = "Tatoonie"
} }
vader :: Character vader :: Human
vader = Character vader = Human
{ id_ = "1001" { _humanChar = CharCommon
, name = "Darth Vader" { _id_ = "1001"
, friends = ["1004"] , _name = "Darth Vader"
, appearsIn = [4,5,6] , _friends = ["1004"]
, _appearsIn = [4,5,6]
}
, homePlanet = "Tatooine" , homePlanet = "Tatooine"
} }
han :: Character han :: Human
han = Character han = Human
{ id_ = "1002" { _humanChar = CharCommon
, name = "Han Solo" { _id_ = "1002"
, friends = ["1000","1003","2001" ] , _name = "Han Solo"
, appearsIn = [4,5,6] , _friends = ["1000","1003","2001" ]
, _appearsIn = [4,5,6]
}
, homePlanet = mempty , homePlanet = mempty
} }
leia :: Character leia :: Human
leia = Character leia = Human
{ id_ = "1003" { _humanChar = CharCommon
, name = "Leia Organa" { _id_ = "1003"
, friends = ["1000","1002","2000","2001"] , _name = "Leia Organa"
, appearsIn = [4,5,6] , _friends = ["1000","1002","2000","2001"]
, _appearsIn = [4,5,6]
}
, homePlanet = "Alderaan" , homePlanet = "Alderaan"
} }
tarkin :: Character tarkin :: Human
tarkin = Character tarkin = Human
{ id_ = "1004" { _humanChar = CharCommon
, name = "Wilhuff Tarkin" { _id_ = "1004"
, friends = ["1001"] , _name = "Wilhuff Tarkin"
, appearsIn = [4] , _friends = ["1001"]
, _appearsIn = [4]
}
, homePlanet = mempty , homePlanet = mempty
} }
threepio :: Character threepio :: Droid
threepio = Character threepio = Droid
{ id_ = "2000" { _droidChar = CharCommon
, name = "C-3PO" { _id_ = "2000"
, friends = ["1000","1002","1003","2001" ] , _name = "C-3PO"
, appearsIn = [ 4, 5, 6 ] , _friends = ["1000","1002","1003","2001" ]
, homePlanet = "Protocol" , _appearsIn = [ 4, 5, 6 ]
}
, primaryFunction = "Protocol"
} }
artoo :: Character artoo :: Droid
artoo = Character artoo = Droid
{ id_ = "2001" { _droidChar = CharCommon
, name = "R2-D2" { _id_ = "2001"
, friends = ["1000","1002","1003"] , _name = "R2-D2"
, appearsIn = [4,5,6] , _friends = ["1000","1002","1003"]
, homePlanet = "Astrometch" , _appearsIn = [4,5,6]
}
, primaryFunction = "Astrometch"
} }
-- ** Helper functions -- ** Helper functions
getHero :: Applicative f => Int -> f Character getHero :: Applicative f => Int -> f Character
getHero 5 = pure luke getHero 5 = pure $ Right luke
getHero _ = pure artoo getHero _ = pure $ Left artoo
getHeroIO :: Int -> IO Character getHeroIO :: Int -> IO Character
getHeroIO = getHero getHeroIO = getHero
getHuman :: Alternative f => ID -> f Character getHuman :: Alternative f => ID -> f Character
getHuman "1000" = pure luke getHuman = fmap Right . getHuman'
getHuman "1001" = pure vader
getHuman "1002" = pure han getHuman' :: Alternative f => ID -> f Human
getHuman "1003" = pure leia getHuman' "1000" = pure luke
getHuman "1004" = pure tarkin getHuman' "1001" = pure vader
getHuman _ = empty getHuman' "1002" = pure han
getHuman' "1003" = pure leia
getHuman' "1004" = pure tarkin
getHuman' _ = empty
getDroid :: Alternative f => ID -> f Character getDroid :: Alternative f => ID -> f Character
getDroid "2000" = pure threepio getDroid = fmap Left . getDroid'
getDroid "2001" = pure artoo
getDroid _ = empty getDroid' :: Alternative f => ID -> f Droid
getDroid' "2000" = pure threepio
getDroid' "2001" = pure artoo
getDroid' _ = empty
getFriends :: Character -> [Character] getFriends :: Character -> [Character]
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char