Skip to content

Commit

Permalink
Merge branch 'master' into server/track-mat-views
Browse files Browse the repository at this point in the history
  • Loading branch information
Sameer Kolhar authored Oct 19, 2020
2 parents a32f4af + a4113eb commit 6631bd9
Show file tree
Hide file tree
Showing 6 changed files with 170 additions and 5 deletions.
32 changes: 32 additions & 0 deletions .github/workflows/hlint.yml
Original file line number Diff line number Diff line change
@@ -0,0 +1,32 @@
name: server lint
on:
pull_request:
paths:
- 'server/**'

jobs:
hlint:
runs-on: ubuntu-20.04
env:
working-directory: ./server
HLINT_BASE_URL: https://dl.haskellworks.io/binaries/hlint
HLINT_VERSION: 3.1.6
HLINT_ARCH: x86_64
HLINT_OS: linux
HLINT_URL: $HLINT_BASE_URL/hlint-${HLINT_VERSION}-${HLINT_ARCH}-${HLINT_OS}.tar.gz

steps:
- uses: actions/checkout@v2
with:
fetch-depth: 0

- name: Download hlint
working-directory: ${{env.working-directory}}
run: |
echo "Downloading from ${{env.HLINT_URL}}"
curl "${{env.HLINT_URL}}" -o "./hlint-${{env.HLINT_VERSION}}-${{env.HLINT_ARCH}}-${{env.HLINT_OS}}.tar.gz"
tar -zxvf "./hlint-${{env.HLINT_VERSION}}-${{env.HLINT_ARCH}}-${{env.HLINT_OS}}.tar.gz" -C "."
- name: Run hlint
shell: bash
run: git diff --name-only origin/${{github.base_ref}}..${{github.sha}} -- ${{env.working-directory}} | grep -E '\.hs$|\.lhs$' | xargs -d '\n' find 2>/dev/null | xargs -d '\n' ${{env.working-directory}}/hlint --json --hint=${{env.working-directory}}/.hlint.yaml | jq -r '.[] | "::" + (if (.severity=="Warning" or .severity=="Error") then "error" else "warning" end) + " file=\(.file),line=\(.startLine),col=\(.startColumn)::\(.severity):" + " \(.hint)%0AFound:%0A \(.from | gsub("\n";"%0A "))%0A" + try ("Perhaps:%0A " + (.to | gsub("\n";"%0A "))) catch ""'
20 changes: 18 additions & 2 deletions scripts/dev.sh
Original file line number Diff line number Diff line change
Expand Up @@ -39,13 +39,14 @@ Available COMMANDs:
Launch a postgres container suitable for use with graphql-engine, watch its logs,
clean up nicely after
test [--integration [pytest_args...] | --unit]
test [--integration [pytest_args...] | --unit | --hlint]
Run the unit and integration tests, handling spinning up all dependencies.
This will force a recompile. A combined code coverage report will be
generated for all test suites.
Either integration or unit tests can be run individually with their
respective flags. With '--integration' any arguments that follow will be
passed to the pytest invocation
passed to the pytest invocation. Run the hlint code linter individually using
'--hlint'.
EOL
exit 1
Expand Down Expand Up @@ -85,15 +86,23 @@ case "${1-}" in
--unit)
RUN_INTEGRATION_TESTS=false
RUN_UNIT_TESTS=true
RUN_HLINT=false
;;
--integration)
PYTEST_ARGS="${@:3}"
RUN_INTEGRATION_TESTS=true
RUN_UNIT_TESTS=false
RUN_HLINT=false
;;
--hlint)
RUN_INTEGRATION_TESTS=false
RUN_UNIT_TESTS=false
RUN_HLINT=true
;;
"")
RUN_INTEGRATION_TESTS=true
RUN_UNIT_TESTS=true
RUN_HLINT=true
;;
*)
die_usage
Expand Down Expand Up @@ -472,6 +481,13 @@ elif [ "$MODE" = "test" ]; then
echo
fi # RUN_INTEGRATION_TESTS

if [ "$RUN_HLINT" = true ]; then

cd "$PROJECT_ROOT/server"
hlint .

fi # RUN_HLINT

# If hpc available, combine any tix from haskell/unit tests:
if command -v hpc >/dev/null; then
if [ "$RUN_UNIT_TESTS" = true ] && [ "$RUN_INTEGRATION_TESTS" = true ]; then
Expand Down
105 changes: 105 additions & 0 deletions server/.hlint.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,105 @@
# HLint configuration file
# https://github.com/ndmitchell/hlint
##########################

# This file contains a template configuration file, which is typically
# placed as .hlint.yaml in the root of your project


# Specify additional command line arguments
#
# - arguments: [--color, --cpp-simple, -XQuasiQuotes]

- arguments: -XQuasiQuotes

# Control which extensions/flags/modules/functions can be used
#
# - extensions:
# - default: false # all extension are banned by default
# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used
# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module
#
# - flags:
# - {name: -w, within: []} # -w is allowed nowhere
#
# - modules:
# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
# - {name: Control.Arrow, within: []} # Certain modules are banned entirely
#
# - functions:
# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules


# Add custom hints for this project
#
# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar"
# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x}


# Turn on hints that are off by default
#
# Ban "module X(module X) where", to require a real export list
# - warn: {name: Use explicit module export list}
#
# Replace a $ b $ c with a . b $ c
# - group: {name: dollar, enabled: true}
#
# Generalise map to fmap, ++ to <>
# - group: {name: generalise, enabled: true}


# Ignore some builtin hints
# - ignore: {name: Use let}
# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules

- ignore: {name: Use <$>}
- ignore: {name: Reduce duplication}
- ignore: {name: Use fromMaybe}
- ignore: {name: Redundant $}
- ignore: {name: Redundant bracket}
- ignore: {name: Use fmap}
- ignore: {name: Use first}
- ignore: {name: Use if}
- ignore: {name: Redundant <$>}
- ignore: {name: Functor law}
- ignore: {name: Move brackets to avoid $}
- ignore: {name: Use null}
- ignore: {name: Use map once}
- ignore: {name: Use ++}
- ignore: {name: Use lambda-case}
- ignore: {name: Use const}
- ignore: {name: Eta reduce}
- ignore: {name: Redundant multi-way if}
- ignore: {name: Use newtype instead of data}
- ignore: {name: Use bimap}
- ignore: {name: Use section}
- ignore: {name: Use $>}
- ignore: {name: Use unless}
- ignore: {name: Redundant $!}
- ignore: {name: "Use ?~"}
- ignore: {name: Use Just}
- ignore: {name: Redundant flip}
- ignore: {name: Use for_}
- ignore: {name: Avoid lambda}
- ignore: {name: Use mapM}
- ignore: {name: Redundant lambda}
- ignore: {name: Use <=<}
- ignore: {name: Replace case with maybe}
- ignore: {name: Use sequenceA}
- ignore: {name: Use camelCase}
- ignore: {name: Avoid lambda using `infix`}
- ignore: {name: Redundant irrefutable pattern}
- ignore: {name: Use tuple-section}
- ignore: {name: Use mapMaybe}
- ignore: {name: Use second}
- ignore: {name: Use isNothing}
- ignore: {name: Use maybe}
- ignore: {name: Redundant return}
- ignore: {name: Unused LANGUAGE pragma}

# Define some custom infix operators
# - fixity: infixr 3 ~^#^~


# To generate a suitable file for HLint do:
# $ hlint --default > .hlint.yaml
3 changes: 3 additions & 0 deletions server/src-lib/Control/Arrow/Extended.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@

{-# LANGUAGE Arrows #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE CPP #-}

-- | The missing standard library for arrows. Some of the functionality in this module is similar to
-- Paterson’s original @arrows@ library, but it has been modernized to work with recent versions of
Expand Down Expand Up @@ -130,6 +131,7 @@ onNothingA f = proc (e, (v, s)) -> case v of
{-# INLINABLE onNothingA #-}

-- These rules are missing from Control.Arrow; see Note [Arrow rewrite rules]
#ifndef __HLINT__
{-# RULES
"arr/arr/R" forall f g h. arr f . (arr g . h) = arr (f . g) . h

Expand Down Expand Up @@ -174,6 +176,7 @@ class (Monad m, Arrow arr) => ArrowKleisli m arr | arr -> m where
"+++/arrM" forall f g. arrM f +++ arrM g = arrM (runKleisli (Kleisli f +++ Kleisli g))
"|||/arrM" forall f g. arrM f ||| arrM g = arrM (runKleisli (Kleisli f ||| Kleisli g))
#-}
#endif

-- | A combinator that serves a similar role to 'returnA' in arrow notation, except that the
-- argument is a monadic action instead of a pure value. Just as 'returnA' is actually just
Expand Down
3 changes: 1 addition & 2 deletions server/src-lib/Control/Concurrent/Extended.hs
Original file line number Diff line number Diff line change
Expand Up @@ -42,8 +42,7 @@ threadDelay = Base.threadDelay

{-# DEPRECATED forkIO
"Please use 'Control.Control.Concurrent.Async.Lifted.Safe.withAsync'\
\ or our 'forkImmortal' instead formore robust threading."
#-}
\ or our 'forkImmortal' instead formore robust threading." #-}
forkIO :: IO () -> IO ThreadId
forkIO = Base.forkIO

Expand Down
12 changes: 11 additions & 1 deletion server/src-lib/Hasura/Incremental/Internal/Rule.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE CPP #-}

-- | Defines the basic 'Rule' datatype and its core operations.
module Hasura.Incremental.Internal.Rule where
Expand Down Expand Up @@ -85,24 +85,29 @@ Rule f `rComp` Rule g = Rule \s a k -> g s a \s' b g' -> f s' b \s'' c f' -> k s
rId :: Rule m a a
rId = Rule \s a k -> k s a rId
{-# INLINABLE[0] rId #-}
#ifndef __HLINT__
{-# RULES
"f/id" forall f. f `rComp` rId = f
"id/f" forall f. rId `rComp` f = f
#-}
#endif

rArr :: (a -> b) -> Rule m a b
rArr f = Rule \s a k -> k s (f a) (rArr f)
{-# INLINABLE[0] rArr #-}
#ifndef __HLINT__
{-# RULES
"arr/id" rArr (\x -> x) = rId
"arr/const" [1] forall x. rArr (\_ -> x) = rPure x
"arr/arr" forall f g. rArr f `rComp` rArr g = rArr (f . g)
"arr/arr/f" forall f g h. (f `rComp` rArr g) `rComp` rArr h = f `rComp` rArr (g . h)
#-}
#endif

rArrM :: (Monad m) => (a -> m b) -> Rule m a b
rArrM f = Rule \s a k -> f a >>= \b -> k s b (rArrM f)
{-# INLINABLE[0] rArrM #-}
#ifndef __HLINT__
{-# RULES
"arrM/arrM" forall f g. rArrM f `rComp` rArrM g = rArrM (f <=< g)
"arr/arrM" forall f g. rArr f `rComp` rArrM g = rArrM (fmap f . g)
Expand All @@ -111,10 +116,12 @@ rArrM f = Rule \s a k -> f a >>= \b -> k s b (rArrM f)
"arr/arrM/f" forall f g h. (f `rComp` rArr g) `rComp` rArrM h = f `rComp` rArrM (fmap g . h)
"arrM/arr/f" forall f g h. (f `rComp` rArrM g) `rComp` rArr h = f `rComp` rArrM (g . h)
#-}
#endif

rFirst :: Rule m a b1 -> Rule m (a, b2) (b1, b2)
rFirst (Rule r) = Rule \s (a, c) k -> r s a \s' b r' -> k s' (b, c) (rFirst r')
{-# INLINABLE[0] rFirst #-}
#ifndef __HLINT__
{-# RULES
"first/id" rFirst rId = rId
"first/arr" forall f. rFirst (rArr f) = rArr (first f)
Expand All @@ -123,13 +130,15 @@ rFirst (Rule r) = Rule \s (a, c) k -> r s a \s' b r' -> k s' (b, c) (rFirst r')
"first/pull" [1] forall f g. rFirst f `rComp` rFirst g = rFirst (f `rComp` g)
"first/f/pull" [1] forall f g h. (f `rComp` rFirst g) `rComp` rFirst h = f `rComp` rFirst (g `rComp` h)
#-}
#endif

rLeft :: Rule m a b1 -> Rule m (Either a b2) (Either b1 b2)
rLeft r0 = go r0 where
go (Rule r) = Rule \s e k -> case e of
Left a -> r s a \s' b r' -> k s' (Left b) (go r')
Right c -> k s (Right c) (go r0)
{-# INLINABLE[0] rLeft #-}
#ifndef __HLINT__
{-# RULES
"left/id" rLeft rId = rId
"left/arr" forall f. rLeft (rArr f) = rArr (left f)
Expand All @@ -138,6 +147,7 @@ rLeft r0 = go r0 where
"left/pull" [1] forall f g. rLeft f `rComp` rLeft g = rLeft (f `rComp` g)
"left/f/pull" [1] forall f g h. (f `rComp` rLeft g) `rComp` rLeft h = f `rComp` rLeft (g `rComp` h)
#-}
#endif

rPure :: b -> Rule m a b
rPure a = Rule \s _ k -> k s a (rPure a)
Expand Down

0 comments on commit 6631bd9

Please sign in to comment.