higherkindness/mu-haskell
1
1
Fork 0
mirror of https://github.com/higherkindness/mu-haskell.git synced 2024-09-11 14:36:01 +03:00
Code Issues Projects Releases Wiki Activity

Add GraphQL queries for all authors, books and find book by title 📚 (#137)

Browse Source
This commit is contained in:
Flavio Corpa 2020-03-12 15:25:45 +01:00 committed by GitHub
parent 14a608e22a
commit efdcdad9ef
1 changed files with 53 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
graphql/exe/Main.hs
View File

@ -14,15 +14,19 @@ module Main where
import Data.List (find)
import Data.Maybe (fromMaybe)
import Data.Proxy
import Data.Text (Text)
import Data.Text (Text, toCaseFold)
import Mu.GraphQL.Server
import Mu.Rpc
import Mu.Schema
import Mu.Server
-- GraphQL App
main :: IO ()
main = runGraphQLApp 8080 libraryServer (Proxy @"Query") (Proxy @"Mutation")
main = do
putStrLn "starting GraphQL server on port 8080"
runGraphQLApp 8080 libraryServer (Proxy @"Query") (Proxy @"Mutation")
type ServiceDefinition
= 'Package ('Just "library")
@ -39,7 +43,14 @@ type ServiceDefinition
, Object "Query" '[]
'[ ObjectField "author" '[]
'[ 'ArgSingle ('Just "name") '[] ('PrimitiveRef Text)]
('RetSingle ('OptionalRef ('ObjectRef "Author")))
('RetSingle ('ListRef ('ObjectRef "Author")))
, ObjectField "book" '[]
'[ 'ArgSingle ('Just "title") '[] ('PrimitiveRef Text)]
('RetSingle ('ListRef ('ObjectRef "Book")))
, ObjectField "authors" '[]
'[] ('RetSingle ('ListRef ('ObjectRef "Author")))
, ObjectField "books" '[]
'[] ('RetSingle ('ListRef ('ObjectRef "Book")))
]
, Object "Mutation" '[] '[]
]
@ -51,33 +62,50 @@ type ServiceMapping = '[
library :: [(Integer, Text, [(Integer, Text)])]
library
= [ (1, "alex", [(1, "haskell is nice"), (2, "haskell is cool")])
, (2, "kant", [(3, "critique of pure reason")])]
= [ (1, "Robert Louis Stevenson", [(1, "Treasure Island"), (2, "Strange Case of Dr Jekyll and Mr Hyde")])
, (2, "Immanuel Kant", [(3, "Critique of Pure Reason")])
, (3, "Michael Ende", [(4, "The Neverending Story"), (5, "Momo")])
]
libraryServer :: forall m. (MonadServer m) => ServerT ServiceMapping ServiceDefinition m _
libraryServer
= Services $ (bookId :<||>: bookTitle :<||>: bookAuthor :<||>: H0)
:<&>: (authorId :<||>: authorName :<||>: authorBooks :<||>: H0)
:<&>: (noContext findAuthor :<||>: H0)
:<&>: (noContext findAuthor
:<||>: noContext findBookTitle
:<||>: noContext allAuthors
:<||>: noContext allBooks
:<||>: H0)
:<&>: H0 :<&>: S0
where bookId (_, bid) = pure bid
bookTitle (aid, bid)
= case find (\(aid', _, _) -> aid == aid') library of
Nothing -> pure ""
Just (_, _, books) -> pure $ fromMaybe "" (lookup bid books)
bookAuthor (aid, _) = pure aid
where
findBook i = find ((==i) . fst3) library
authorId = pure
authorName aid
= case find (\(aid', _, _) -> aid == aid') library of
Nothing -> pure ""
Just (_, aname, _) -> pure aname
authorBooks aid
= case find (\(aid', _, _) -> aid == aid') library of
Nothing -> pure []
Just (_, _, books) -> pure $ map ((aid, ) . fst) books
bookId (_, bid) = pure bid
bookTitle (aid, bid) = pure $ maybe "" (fromMaybe "" . lookup bid . trd3) (findBook aid)
bookAuthor (aid, _) = pure aid
findAuthor aname
= case find (\(_, aname', _) -> aname == aname') library of
Nothing -> pure Nothing
Just (aid, _, _) -> pure $ Just aid
authorId = pure
authorName aid = pure $ maybe "" snd3 (findBook aid)
authorBooks aid = pure $ maybe [] (map ((aid,) . fst) . trd3) (findBook aid)
findAuthor aname = pure
[aid | (aid, aname', _) <- library, toCaseFold aname == toCaseFold aname']
findBookTitle title = pure
[(aid, bid) | (aid, _, books) <- library
, (bid, title') <- books
, toCaseFold title == toCaseFold title']
allAuthors = pure $ fst3 <$> library
allBooks = pure [(aid, bid) | (aid, _, books) <- library, (bid, _) <- books]
-- helpers
fst3 :: (a, b, c) -> a
fst3 (x, _, _) = x
snd3 :: (a, b, c) -> b
snd3 (_, y, _) = y
trd3 :: (a, b, c) -> c
trd3 (_, _, z) = z