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

Improve GraphQL example library 📚 (#249)

Browse Source
This commit is contained in:
Flavio Corpa 2020-11-09 17:14:03 +01:00 committed by GitHub
parent 9900fd94f3
commit 533bd894f3
3 changed files with 72 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
examples/library/mu-example-library.cabal
View File

@ -1,18 +1,22 @@
name: mu-example-library
version: 0.3.0.0
synopsis: Example of a mu-haskell project using Persistent and GraphQL
description: Example of a mu-haskell project using Persistent and GraphQL.
author: Alejandro Serrano
maintainer: alejandro.serrano@47deg.com
copyright: Copyright © 2019-2020 47 Degrees. <http://47deg.com>
category: Network
build-type: Simple
cabal-version: >=1.10
data-files: library.graphql
name: mu-example-library
version: 0.3.0.0
synopsis:
Example of a mu-haskell project using Persistent and GraphQL
description:
Example of a mu-haskell project using Persistent and GraphQL.
author: Alejandro Serrano, Flavio Corpa
maintainer: alejandro.serrano@47deg.com
copyright: Copyright © 2019-2020 47 Degrees. <http://47deg.com>
category: Network
build-type: Simple
cabal-version: >=1.10
data-files: library.graphql
homepage:
https://github.com/higherkindness/mu-haskell/examples/library
bug-reports: https://github.com/higherkindness/mu-haskell/issues
bug-reports: https://github.com/higherkindness/mu-haskell/issues
executable library
hs-source-dirs: src
@ -23,10 +27,10 @@ executable library
base >=4.12 && <5
, conduit >=1.3.2 && <2
, monad-logger >=0.3 && <0.4
, mtl
, mtl >=0.2
, mu-graphql >=0.4
, mu-persistent >=0.3
, mu-prometheus >=0.4
, mu-graphql >=0.4
, mu-rpc >=0.4
, mu-schema >=0.3
, persistent >=2.10 && <3
@ -35,4 +39,3 @@ executable library
, text >=1.2 && <2
, wai-extra >=3 && <4
, warp >=3.3 && <4

26
examples/library/src/Schema.hs
View File

@ -3,32 +3,26 @@
{-# language DeriveAnyClass #-}
{-# language DeriveGeneric #-}
{-# language DerivingStrategies #-}
{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language GADTs #-}
{-# language GeneralizedNewtypeDeriving #-}
{-# language MultiParamTypeClasses #-}
{-# language OverloadedStrings #-}
{-# language PartialTypeSignatures #-}
{-# language PolyKinds #-}
{-# language QuasiQuotes #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneDeriving #-}
{-# language TemplateHaskell #-}
{-# language TupleSections #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# language UndecidableInstances #-}
module Schema where
import Data.Int (Int32, Int64)
import Data.Int (Int64)
import qualified Data.Text as T
import Database.Persist.Sqlite
import Database.Persist.TH
import GHC.Generics
import Mu.GraphQL.Quasi
import Mu.Schema
import Database.Persist.Sqlite (BackendKey (SqlBackendKey), toSqlKey)
import Database.Persist.TH (mkMigrate, mkPersist, persistLowerCase, share,
sqlSettings)
import GHC.Generics (Generic)
import Mu.GraphQL.Quasi (graphql)
import Mu.Schema (FromSchema)
#if __GHCIDE__
graphql "Library" "examples/library/library.graphql"
@ -51,12 +45,12 @@ Book json
toAuthorId :: Int64 -> AuthorId
toAuthorId = toSqlKey
newtype NewAuthor = NewAuthor { name :: T.Text }
newtype NewAuthor
= NewAuthor { name :: T.Text }
deriving stock (Eq, Show, Generic)
deriving anyclass (FromSchema LibrarySchema "NewAuthor")
data NewBook
= NewBook { title :: T.Text
, authorId :: Integer }
= NewBook { title :: T.Text, authorId :: Integer }
deriving stock (Eq, Show, Generic)
deriving anyclass (FromSchema LibrarySchema "NewBook")

92
examples/library/src/Server.hs
View File

@ -1,27 +1,22 @@
{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language OverloadedStrings #-}
{-# language PartialTypeSignatures #-}
{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language TypeFamilies #-}
{-# language TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-partial-type-signatures #-}
{-# options_ghc -fno-warn-partial-type-signatures #-}
module Main where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger
import Data.Conduit
import Control.Monad.Logger (LoggingT, runStderrLoggingT)
import Data.Conduit (ConduitT, Void, runConduit, (.|))
import Data.Maybe (fromJust)
import qualified Data.Text as T
import Database.Persist
import Database.Persist.Sqlite
import Mu.Adapter.Persistent (runDb)
import Mu.GraphQL.Quasi
import Mu.GraphQL.Server
import Mu.Instrumentation.Prometheus
import Mu.Schema
import Mu.GraphQL.Server (graphQLApp, liftServerConduit)
import Mu.Instrumentation.Prometheus (initPrometheus, prometheus)
import Mu.Schema (Mapping ((:->)), Proxy (Proxy))
import Mu.Server
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.AddHeaders (addHeaders)
@ -51,20 +46,18 @@ main = do
(Proxy @('Just "Subscription"))
{- | Inserts demo data to make this example valueable for testing with different clients
Returns Nothing in case of any failure, including attempts to insert non-unique values
Returns Nothing in case of any failure, including attempts to insert non-unique values
-}
insertSeedData :: SqlBackend -> LoggingT IO (Maybe ())
insertSeedData conn = sequence_ <$> sequence
[ insertAuthorAndBooks conn (Author "Robert Louis Stevenson")
[Book "Treasure Island", Book "Strange Case of Dr Jekyll and Mr Hyde"]
, insertAuthorAndBooks conn (Author "Immanuel Kant")
[Book "Critique of Pure Reason"]
, insertAuthorAndBooks conn (Author "Michael Ende")
[Book "The Neverending Story", Book "Momo"]
]
insertSeedData conn = sequence_ <$> traverse (uncurry $ insertAuthorAndBooks conn) seedData
where seedData =
[ (Author "Robert Louis Stevenson", [Book "Treasure Island", Book "Strange Case of Dr Jekyll and Mr Hyde"])
, (Author "Immanuel Kant", [Book "Critique of Pure Reason"])
, (Author "Michael Ende", [Book "The Neverending Story", Book "Momo"])
]
{- | Inserts Author and Books
Returns Nothing in case of any failure, including attempts to insert non-unique values
Returns Nothing in case of any failure, including attempts to insert non-unique values
-}
insertAuthorAndBooks :: SqlBackend -> Author -> [Key Author -> Book] -> LoggingT IO (Maybe ())
insertAuthorAndBooks conn author books =
@ -79,50 +72,53 @@ type ObjectMapping = '[
, "Author" ':-> Entity Author
]
libraryServer :: forall i.
SqlBackend
-> ServerT ObjectMapping i Library ServerErrorIO _
libraryServer conn
= resolver ( object @"Book" ( field @"id" bookId
, field @"title" bookTitle
, field @"author" bookAuthor )
, object @"Author" ( field @"id" authorId
, field @"name" authorName
, field @"books" authorBooks )
, object @"Query" ( method @"authors" allAuthors
, method @"books" allBooks )
, object @"Mutation" ( method @"newAuthor" newAuthor
, method @"newBook" newBook )
, object @"Subscription" ( method @"allBooks" allBooksConduit )
)
libraryServer :: SqlBackend -> ServerT ObjectMapping i Library ServerErrorIO _
libraryServer conn = resolver
( object @"Book"
( field @"id" bookId
, field @"title" bookTitle
, field @"author" bookAuthor
)
, object @"Author"
( field @"id" authorId
, field @"name" authorName
, field @"books" authorBooks
)
, object @"Query"
( method @"authors" allAuthors
, method @"books" allBooks
)
, object @"Mutation"
( method @"newAuthor" newAuthor
, method @"newBook" newBook
)
, object @"Subscription"
( method @"allBooks" allBooksConduit )
)
where
bookId :: Entity Book -> ServerErrorIO Integer
bookId (Entity (BookKey k) _) = pure $ toInteger k
bookTitle :: Entity Book -> ServerErrorIO T.Text
bookTitle (Entity _ Book { bookTitle = t }) = pure t
bookAuthor :: Entity Book -> ServerErrorIO (Entity Author)
bookAuthor (Entity _ Book { bookAuthor = a })
= runDb conn $ Entity a . fromJust <$> get a
bookAuthor (Entity _ Book { bookAuthor = a }) = runDb conn $ Entity a . fromJust <$> get a
authorId :: Entity Author -> ServerErrorIO Integer
authorId (Entity (AuthorKey k) _) = pure $ toInteger k
authorName :: Entity Author -> ServerErrorIO T.Text
authorName (Entity _ Author { authorName = t }) = pure t
authorBooks :: Entity Author -> ServerErrorIO [Entity Book]
authorBooks (Entity a _)
= runDb conn $ selectList [BookAuthor ==. a] [Asc BookTitle]
authorBooks (Entity a _) = runDb conn $ selectList [BookAuthor ==. a] [Asc BookTitle]
allAuthors :: T.Text -> ServerErrorIO [Entity Author]
allAuthors nameFilter
= runDb conn $ selectList [Filter AuthorName (FilterValue nameFilter) (BackendSpecificFilter "LIKE")]
[Asc AuthorName]
= runDb conn $ selectList [Filter AuthorName (FilterValue nameFilter) (BackendSpecificFilter "LIKE")] [Asc AuthorName]
allBooks :: T.Text -> ServerErrorIO [Entity Book]
allBooks titleFilter
= runDb conn $ selectList [Filter BookTitle (FilterValue titleFilter) (BackendSpecificFilter "LIKE")]
[Asc BookTitle]
= runDb conn $ selectList [Filter BookTitle (FilterValue titleFilter) (BackendSpecificFilter "LIKE")] [Asc BookTitle]
allBooksConduit :: ConduitT (Entity Book) Void ServerErrorIO () -> ServerErrorIO ()
allBooksConduit sink
= runDb conn $ runConduit $
selectSource [] [Asc BookTitle] .| liftServerConduit sink
allBooksConduit sink = runDb conn $ runConduit $ selectSource [] [Asc BookTitle] .| liftServerConduit sink
newAuthor :: NewAuthor -> ServerErrorIO (Entity Author)
newAuthor (NewAuthor name) = do