Skip to content

Commit

Permalink
Optimize scrips (#868)
Browse files Browse the repository at this point in the history
* optimize scripts

* changelog

* release

* remove unused

* package

* remove deps

* hconf

* release

* cli

* release

* release

* files

* cmd

* format

* format

* release

* update

* scripts

* update

* hconf

* update

* release

* release

* update

* update

* update

* BUFFER

* BUFFER

* BUFFER
  • Loading branch information
nalchevanidze committed Jun 11, 2024
1 parent 84b2f00 commit 8dd9abb
Show file tree
Hide file tree
Showing 146 changed files with 1,096 additions and 1,211 deletions.
9 changes: 5 additions & 4 deletions .github/workflows/haskell-ci.yml
Original file line number Diff line number Diff line change
Expand Up @@ -49,10 +49,11 @@ jobs:
format:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2
- uses: mrkkrp/ormolu-action@v7
with:
pattern: morpheus-graphql*/**/*.hs
- uses: actions/checkout@v4
- uses: ./.github/actions/setup-hs
- name: check
shell: bash
run: hconf format --check

concurrency:
group: ${{ github.ref }}
Expand Down
20 changes: 10 additions & 10 deletions examples/client/src/Client/DefineByIntrospection.hs
Original file line number Diff line number Diff line change
Expand Up @@ -77,16 +77,16 @@ declareLocalTypesInline

usersApi :: ByteString -> IO ByteString
usersApi _ =
pure $
"{\"data\":{"
<> "\"myUser\":{ "
<> " \"boo3\": \"name\","
<> " \"myUserEmail\": \"some field\","
<> " \"address\":{ \"city\":\"some city\" },"
<> " \"customAdress\":{ \"customCity\":\"some custom city\" }"
<> "},"
<> " \"user\":{ \"email\":\"some email\" }"
<> "}}"
pure
$ "{\"data\":{"
<> "\"myUser\":{ "
<> " \"boo3\": \"name\","
<> " \"myUserEmail\": \"some field\","
<> " \"address\":{ \"city\":\"some city\" },"
<> " \"customAdress\":{ \"customCity\":\"some custom city\" }"
<> "},"
<> " \"user\":{ \"email\":\"some email\" }"
<> "}}"

fetchUsers :: IO (Either (FetchError GetUser) GetUser)
fetchUsers = fetch usersApi userArgs
Expand Down
8 changes: 4 additions & 4 deletions examples/code-gen-docs/src/Server/API.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@ import Scalars (Markdown (..))
import Server.Blog

resolvePost ::
Monad m =>
(Monad m) =>
ID ->
m (Post m)
resolvePost (ID x) =
Expand All @@ -21,7 +21,7 @@ resolvePost (ID x) =
}

resolveUser ::
Monad m =>
(Monad m) =>
ID ->
m (User m)
resolveUser (ID x) =
Expand All @@ -31,15 +31,15 @@ resolveUser (ID x) =
posts = traverse resolvePost ["id1", "id2"]
}

resolveQuery :: Monad m => Query m
resolveQuery :: (Monad m) => Query m
resolveQuery =
Query
{ getPosts = traverse resolvePost ["id1", "id2"],
getUsers = traverse resolveUser ["id1", "id2"]
}

rootResolver ::
Monad m =>
(Monad m) =>
RootResolver m () Query Undefined Undefined
rootResolver = defaultRootResolver {queryResolver = resolveQuery}

Expand Down
20 changes: 10 additions & 10 deletions examples/code-gen/src/Domains/Posts/Resolver.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,19 +10,19 @@ import Data.Morpheus.Types
import Domains.Posts.Posts

resolvePost ::
Monad m =>
(Monad m) =>
ID ->
m (Maybe (Post m))
resolvePost postId =
pure $
Just $
Post
{ Domains.Posts.Posts.id = pure postId,
title = pure "Post Tittle",
authorID = pure "Post Author"
}
pure
$ Just
$ Post
{ Domains.Posts.Posts.id = pure postId,
title = pure "Post Tittle",
authorID = pure "Post Author"
}

resolveQuery :: Monad m => Query m
resolveQuery :: (Monad m) => Query m
resolveQuery =
Query
{ posts =
Expand All @@ -36,7 +36,7 @@ resolveQuery =
}

rootResolver ::
Monad m =>
(Monad m) =>
RootResolver m () Query Undefined Undefined
rootResolver = defaultRootResolver {queryResolver = resolveQuery}

Expand Down
18 changes: 9 additions & 9 deletions examples/code-gen/src/Domains/Users/Resolver.hs
Original file line number Diff line number Diff line change
Expand Up @@ -10,18 +10,18 @@ import Data.Morpheus.Types
import Domains.Users.Users

resolveUser ::
Monad m =>
(Monad m) =>
ID ->
m (Maybe (User m))
resolveUser postId =
pure $
Just $
User
{ Domains.Users.Users.id = pure postId,
name = pure "User Tittle"
}
pure
$ Just
$ User
{ Domains.Users.Users.id = pure postId,
name = pure "User Tittle"
}

resolveQuery :: Monad m => Query m
resolveQuery :: (Monad m) => Query m
resolveQuery =
Query
{ users =
Expand All @@ -35,7 +35,7 @@ resolveQuery =
}

rootResolver ::
Monad m =>
(Monad m) =>
RootResolver m () Query Undefined Undefined
rootResolver = defaultRootResolver {queryResolver = resolveQuery}

Expand Down
6 changes: 3 additions & 3 deletions examples/scotty-fraxl/src/Fraxl/API.hs
Original file line number Diff line number Diff line change
Expand Up @@ -235,7 +235,7 @@ isSchema = param "schema"

httpEndpoint :: RoutePattern -> ScottyM ()
httpEndpoint route = do
get route $
(isSchema *> raw (render app))
<|> raw httpPlayground
get route
$ (isSchema *> raw (render app))
<|> raw httpPlayground
post route (raw . DB.runQuery . runFraxl fetchSource . runApp app =<< body)
4 changes: 2 additions & 2 deletions examples/scotty-freer-simple/src/API.hs
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ importGQLDocument =<< makeRelativeToProject "src/api.gql"
api :: (Member DR.DeityRepo effs, Typeable effs) => ByteString -> Eff effs ByteString
api = interpreter rootResolver

rootResolver :: Member DR.DeityRepo effs => RootResolver (Eff effs) () Query Mutation Undefined
rootResolver :: (Member DR.DeityRepo effs) => RootResolver (Eff effs) () Query Mutation Undefined
rootResolver =
defaultRootResolver
{ queryResolver = Query {deity = deityResolver},
Expand All @@ -62,5 +62,5 @@ toResponse ::
toResponse (Right deity) = Right $ toResponse' deity
toResponse (Left error) = Left $ show error

toResponse' :: Applicative m => T.Deity -> Deity m
toResponse' :: (Applicative m) => T.Deity -> Deity m
toResponse' (T.Deity name power) = Deity {name = pure name, power = pure power}
4 changes: 2 additions & 2 deletions examples/scotty-freer-simple/src/DeityRepo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,8 +15,8 @@ data DeityRepo r where
CreateDeity :: Deity -> DeityRepo (Either Error Deity)

-- Interface for use
getDeityByName :: Member DeityRepo effs => Name -> Eff effs (Either Error Deity)
getDeityByName :: (Member DeityRepo effs) => Name -> Eff effs (Either Error Deity)
getDeityByName name = send $ GetDeityByName name

createDeity :: Member DeityRepo effs => Deity -> Eff effs (Either Error Deity)
createDeity :: (Member DeityRepo effs) => Deity -> Eff effs (Either Error Deity)
createDeity deity = send $ CreateDeity deity
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ exampleDeityRepoHandler dbRef =
writeIORef dbRef $ addOrReplace diety deities
pure (Right diety)

addOrReplace :: Eq a => a -> [a] -> [a]
addOrReplace :: (Eq a) => a -> [a] -> [a]
addOrReplace a as = a : filter (/= a) as

toEither :: b -> Maybe a -> Either b a
Expand Down
4 changes: 2 additions & 2 deletions examples/scotty-freer-simple/src/Lib.hs
Original file line number Diff line number Diff line change
Expand Up @@ -32,8 +32,8 @@ server' showStart readyAction = do
routes
where
settings =
setBeforeMainLoop readyAction $
setPort
setBeforeMainLoop readyAction
$ setPort
8080
defaultSettings
showStartMessage = if showStart then 1 else 0
Expand Down
2 changes: 1 addition & 1 deletion examples/scotty-haxl/src/HaxlAPI/API.hs
Original file line number Diff line number Diff line change
Expand Up @@ -100,7 +100,7 @@ httpEndpoint route = do
get route $ (isSchema *> raw (render app)) <|> raw httpPlayground
post route $ raw =<< (liftIO . runHaxlApp (deriveApp rootResolver) =<< body)

runHaxlApp :: MapAPI a b => App e Haxl -> a -> IO b
runHaxlApp :: (MapAPI a b) => App e Haxl -> a -> IO b
runHaxlApp haxlApp input = do
let stateStore = stateSet DeityState stateEmpty
environment <- initEnv stateStore ()
Expand Down
2 changes: 1 addition & 1 deletion examples/scotty-haxl/src/HaxlAPI/DataSource.hs
Original file line number Diff line number Diff line change
Expand Up @@ -83,7 +83,7 @@ instance DataSourceName DeityReq where
instance DataSource u DeityReq where
fetch _ _ _ = BackgroundFetch myfetch

fetchAll :: Foldable t => t (ResultVar [ID]) -> IO ()
fetchAll :: (Foldable t) => t (ResultVar [ID]) -> IO ()
fetchAll allIdVars = do
allIds <- fetchDeityIds
mapM_ (`putSuccess` allIds) allIdVars
Expand Down
32 changes: 16 additions & 16 deletions examples/scotty/src/Server/MonadIO/API.hs
Original file line number Diff line number Diff line change
Expand Up @@ -186,9 +186,9 @@ loginResolver LoginArgs {username, password} = do
| userId userRow == 1 = tokenUser1
| userId userRow == 2 = tokenUser2
| otherwise = tokenUser3
pure $
Just $
Session {token = pure tokenUser, user = userResolver userRow}
pure
$ Just
$ Session {token = pure tokenUser, user = userResolver userRow}
Nothing -> fail "Invalid user or password"

getUserResolver :: (RESOLVER t) => Arg "id" Int -> Wrapped t Maybe User
Expand Down Expand Up @@ -224,8 +224,8 @@ addDogResolver (Arg name) = do
-------------------------------------------------------------------------------
userResolver :: (RESOLVER t) => UserRow -> Value t User
userResolver UserRow {userId = thisUserId, userFullName} =
pure $
User
pure
$ User
{ id = idResolver,
name = nameResolver,
favoriteDog = favoriteDogResolver,
Expand Down Expand Up @@ -271,14 +271,14 @@ api = interpreter rootResolver
app :: IO ()
app = do
db <- newTVarIO dbInit
scotty 8080 $
post "/api" $
do
reqBody <- body
reqHeaders <- headers
let env = Env db $ map (both $ T.pack . LT.unpack) reqHeaders
res <-
liftIO . runExceptT . flip runReaderT env . runWeb $ api reqBody
case res of
Left code -> status $ Status code "Error"
Right rawResponse -> raw rawResponse
scotty 8080
$ post "/api"
$ do
reqBody <- body
reqHeaders <- headers
let env = Env db $ map (both $ T.pack . LT.unpack) reqHeaders
res <-
liftIO . runExceptT . flip runReaderT env . runWeb $ api reqBody
case res of
Left code -> status $ Status code "Error"
Right rawResponse -> raw rawResponse
2 changes: 1 addition & 1 deletion examples/scotty/src/Server/Mythology/API.hs
Original file line number Diff line number Diff line change
Expand Up @@ -67,7 +67,7 @@ resolveDeity :: DeityArgs -> ResolverQ e IO Deity
resolveDeity DeityArgs {name, bornPlace} =
liftEither $ dbDeity name bornPlace

resolveCharacter :: Applicative m => [Character m]
resolveCharacter :: (Applicative m) => [Character m]
resolveCharacter =
[ CharacterHuman someHuman,
CharacterDeity someDeity,
Expand Down
20 changes: 10 additions & 10 deletions examples/scotty/src/Server/Mythology/Character.hs
Original file line number Diff line number Diff line change
Expand Up @@ -45,15 +45,15 @@ data Human m = Human

type PersonGuard m = TypeGuard Person (UnionPerson m)

resolvePersons :: Applicative m => [PersonGuard m]
resolvePersons :: (Applicative m) => [PersonGuard m]
resolvePersons = ResolveType <$> [UnionPersonDeity someDeity, UnionPersonHuman someHuman]

data UnionPerson m
= UnionPersonDeity Deity
| UnionPersonHuman (Human m)
deriving (Generic, GQLType)

someHuman :: Applicative m => Human m
someHuman :: (Applicative m) => Human m
someHuman = Human {name = pure "Odysseus", bornAt = pure Ithaca}

someDeity :: Deity
Expand All @@ -67,11 +67,11 @@ someDeity =

dbDeity :: Text -> Maybe City -> IO (Either String Deity)
dbDeity _ bornAt =
return $
Right $
Deity
{ name = "Morpheus",
power = Just "Shapeshifting",
realm = Dream,
bornAt
}
return
$ Right
$ Deity
{ name = "Morpheus",
power = Just "Shapeshifting",
realm = Dream,
bornAt
}
8 changes: 4 additions & 4 deletions examples/scotty/src/Server/NamedResolvers/Authors.hs
Original file line number Diff line number Diff line change
Expand Up @@ -63,8 +63,8 @@ instance ResolveNamed m (Author (NamedResolverT m)) where
resolveBatched = traverse getAuthor
where
getAuthor uid =
pure $
Just
pure
$ Just
Author
{ authorId = resolve (pure uid),
role = resolve (pure uid),
Expand All @@ -85,8 +85,8 @@ instance ResolveNamed m (Post (NamedResolverT m)) where
resolveBatched = traverse getPost
where
getPost uid =
pure $
Just
pure
$ Just
Post
{ author = resolve (pure uid)
}
Expand Down
2 changes: 1 addition & 1 deletion examples/scotty/src/Server/NamedResolvers/Pages.hs
Original file line number Diff line number Diff line change
Expand Up @@ -59,7 +59,7 @@ data Query m = Query
GQLType
)

instance MonadError GQLError m => ResolveNamed m (Query (NamedResolverT m)) where
instance (MonadError GQLError m) => ResolveNamed m (Query (NamedResolverT m)) where
type Dep (Query (NamedResolverT m)) = ()
resolveBatched _ =
pure
Expand Down
14 changes: 7 additions & 7 deletions examples/scotty/src/Server/NamedResolvers/Posts.hs
Original file line number Diff line number Diff line change
Expand Up @@ -50,12 +50,12 @@ data Post m = Post

getPost :: (Monad m) => ID -> m (Maybe (Post (NamedResolverT m)))
getPost pid =
pure $
Just $
Post
{ postID = resolve (pure pid),
title = resolve (pure $ "title for \"" <> unpackID pid <> "\"")
}
pure
$ Just
$ Post
{ postID = resolve (pure pid),
title = resolve (pure $ "title for \"" <> unpackID pid <> "\"")
}

instance ResolveNamed m (Post (NamedResolverT m)) where
type Dep (Post (NamedResolverT m)) = ID
Expand All @@ -71,7 +71,7 @@ data Query m = Query
GQLType
)

instance MonadError GQLError m => ResolveNamed m (Query (NamedResolverT m)) where
instance (MonadError GQLError m) => ResolveNamed m (Query (NamedResolverT m)) where
type Dep (Query (NamedResolverT m)) = ()
resolveBatched _ =
pure
Expand Down
Loading

0 comments on commit 8dd9abb

Please sign in to comment.