mirror of
https://github.com/higherkindness/mu-haskell.git
synced 2024-09-11 14:36:01 +03:00
Add GraphQL queries for all authors, books and find book by title 📚 (#137)
This commit is contained in:
parent
14a608e22a
commit
efdcdad9ef
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user