mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-09-11 02:25:43 +03:00
Stop using stack in Travis (#121)
The travis cache appears to be broken (probably due to the nightly stack?), but it just means CI takes like half an hour now. Since I already build on stack, I'm pretty sure it's fine --- also this will give a sanity check against accidentally breaking cabal build plans. This improves CI times from ~30 minutes down to ~2.
This commit is contained in:
Sandy Maguire
GitHub
parent
78d0c4905a
commit
c3d3cc24f8
60
.travis.yml
60
.travis.yml
@ -1,44 +1,36 @@
|
||||
# Adapted from https://github.com/commercialhaskell/stack
|
||||
language: c
|
||||
sudo: false
|
||||
language: haskell
|
||||
dist: trusty
|
||||
|
||||
cache:
|
||||
directories:
|
||||
- $HOME/.ghc
|
||||
- $HOME/.cabal
|
||||
- $HOME/.stack
|
||||
- .stack-work
|
||||
directories:
|
||||
- $HOME/.cabal/store
|
||||
|
||||
cabal: "2.4"
|
||||
|
||||
matrix:
|
||||
include:
|
||||
# ghc 8.6.3
|
||||
- env: STACK='stack --resolver=lts-13.0' CACHE_NAME=8.6.3
|
||||
addons: {apt: {packages: [libgmp-dev]}}
|
||||
|
||||
# nightly
|
||||
- env: STACK='stack --resolver=nightly' CACHE_NAME=nightly
|
||||
addons: {apt: {packages: [libgmp-dev]}}
|
||||
|
||||
# Use the resolver in stack.yaml
|
||||
- env: STACK=stack CACHE_NAME=stack-linux
|
||||
addons: {apt: {packages: [libgmp-dev]}}
|
||||
|
||||
- env: STACK=stack CACHE_NAME=stack-osx
|
||||
os: osx
|
||||
addons: {apt: {packages: [libgmp-dev]}}
|
||||
|
||||
- ghc: "8.6.3"
|
||||
# - ghc: "8.4.4"
|
||||
# - ghc: "8.2.2"
|
||||
# - ghc: "8.0.2"
|
||||
# - ghc: "7.10.3"
|
||||
# - ghc: "7.8.4"
|
||||
# - ghc: "7.6.3"
|
||||
|
||||
install:
|
||||
- unset CC
|
||||
- export PATH=$HOME/.local/bin:/opt/ghc/$GHCVER/bin:$PATH
|
||||
- ./.travis/install-stack.sh
|
||||
- cabal --version
|
||||
- ghc --version
|
||||
|
||||
script:
|
||||
- echo "$($STACK ghc -- --version) [$($STACK ghc -- --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
||||
- GHC_OPTIONS="-Werror"
|
||||
- |
|
||||
set -ex
|
||||
$STACK --no-terminal build --ghc-options="$GHC_OPTIONS"
|
||||
$STACK test --ghc-options="$GHC_OPTIONS"
|
||||
set +ex
|
||||
- cabal v2-update
|
||||
- cabal v2-build
|
||||
- cabal v2-test --enable-test
|
||||
- cabal new-haddock
|
||||
- cabal check
|
||||
- cabal sdist # tests that a source-distribution can be generated
|
||||
|
||||
# Check that the resulting source distribution can be built & installed.
|
||||
# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
|
||||
# `cabal install --force-reinstalls dist/*-*.tar.gz`
|
||||
- SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
|
||||
(cd dist && cabal install --force-reinstalls "$SRC_TGZ")
|
||||
|
||||
@ -1,29 +0,0 @@
|
||||
#!/bin/sh
|
||||
|
||||
# Adapted from https://github.com/commercialhaskell/stack
|
||||
|
||||
set -eux
|
||||
|
||||
travis_retry() {
|
||||
cmd=$*
|
||||
$cmd || (sleep 2 && $cmd) || (sleep 10 && $cmd)
|
||||
}
|
||||
|
||||
fetch_stack_osx() {
|
||||
curl -skL https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin;
|
||||
}
|
||||
|
||||
fetch_stack_linux() {
|
||||
curl -sL https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack';
|
||||
}
|
||||
|
||||
# We need stack to generate cabal files with precise bounds, even for cabal
|
||||
# builds.
|
||||
mkdir -p ~/.local/bin;
|
||||
if [ "$(uname)" = "Darwin" ]; then
|
||||
travis_retry fetch_stack_osx
|
||||
else
|
||||
travis_retry fetch_stack_linux
|
||||
fi
|
||||
|
||||
travis_retry $STACK --no-terminal setup;
|
||||
@ -4,7 +4,7 @@ cabal-version: 1.12
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 3f16c72f17a2b211f296fedc1a93db88198f2f05fc66b94d1e277319c3a76613
|
||||
-- hash: 8215f1fa69bdaae106988aaf84f4a2dd2338231d1fc11ddf7dd30a9d8b61449b
|
||||
|
||||
name: polysemy
|
||||
version: 0.4.0.0
|
||||
@ -98,6 +98,7 @@ test-suite polysemy-test
|
||||
InspectorSpec
|
||||
OutputSpec
|
||||
ThEffectSpec
|
||||
TypeErrors
|
||||
Paths_polysemy
|
||||
hs-source-dirs:
|
||||
test
|
||||
|
||||
@ -1,173 +1,8 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
|
||||
module DoctestSpec where
|
||||
|
||||
import Test.DocTest
|
||||
import Test.Hspec
|
||||
|
||||
-- $setup
|
||||
-- >>> default ()
|
||||
-- >>> :m +Polysemy
|
||||
-- >>> :m +Polysemy.Output
|
||||
-- >>> :m +Polysemy.Reader
|
||||
-- >>> :m +Polysemy.Resource
|
||||
-- >>> :m +Polysemy.State
|
||||
-- >>> :m +Polysemy.Trace
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
-- foo :: Sem r ()
|
||||
-- foo = put ()
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... Ambiguous use of effect 'State'
|
||||
-- ...
|
||||
-- ... (Member (State ()) r) ...
|
||||
-- ...
|
||||
ambiguousMonoState = ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
-- foo :: Sem r ()
|
||||
-- foo = put 5
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... Ambiguous use of effect 'State'
|
||||
-- ...
|
||||
-- ... (Member (State s0) r) ...
|
||||
-- ...
|
||||
-- ... 's0' directly...
|
||||
-- ...
|
||||
ambiguousPolyState = ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- TODO(sandy): should this mention 'Reader i' or just 'Reader'?
|
||||
--
|
||||
-- >>> :{
|
||||
-- interpret @Reader $ \case
|
||||
-- Ask -> undefined
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... 'Reader i' is higher-order, but 'interpret' can help only
|
||||
-- ... with first-order effects.
|
||||
-- ...
|
||||
-- ... 'interpretH' instead.
|
||||
-- ...
|
||||
interpretBadFirstOrder = ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
-- runFoldMapOutput
|
||||
-- :: forall o m r a
|
||||
-- . Monoid m
|
||||
-- => (o -> m)
|
||||
-- -> Sem (Output o ': r) a
|
||||
-- -> Sem r (m, a)
|
||||
-- runFoldMapOutput f = runState mempty . reinterpret $ \case
|
||||
-- Output o -> modify (<> f o)
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... Probable cause: ...reinterpret... is applied to too few arguments
|
||||
-- ...
|
||||
tooFewArgumentsReinterpret = ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
-- let reinterpretScrub :: Sem (Output Int ': m) a -> Sem (State Bool ': Trace ': m) a
|
||||
-- reinterpretScrub = undefined
|
||||
-- foo :: Sem '[Output Int] ()
|
||||
-- foo = pure ()
|
||||
-- foo' = reinterpretScrub foo
|
||||
-- foo'' = runState True foo'
|
||||
-- foo''' = runTraceIO foo''
|
||||
-- in runM foo'''
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... Ambiguous use of effect 'Lift'
|
||||
-- ...
|
||||
-- ... add (Member (Lift IO) '[]) ...
|
||||
-- ...
|
||||
--
|
||||
-- PROBLEM: We're trying to run more effects than exist in the eff row. This is
|
||||
-- indeed a problem, but the error message isn't helpful.
|
||||
--
|
||||
-- SOLUTION: Add a special case to `AmbiguousSend` when `r ~ '[]`.
|
||||
runningTooManyEffects'WRONG = ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
-- foo :: Sem (State Int ': r) ()
|
||||
-- foo = put ()
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... Ambiguous use of effect 'State'
|
||||
-- ...
|
||||
-- ... (Member (State ()) State Int : r) ...
|
||||
-- ...
|
||||
--
|
||||
-- PROBLEM: There should be parentheses around `State Int : r`
|
||||
--
|
||||
-- SOLUTION: Emit parens only when the effect row is of the form `e1 ': ...`
|
||||
missingParens'WRONG = ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
-- let foo :: Member Resource r => Sem r ()
|
||||
-- foo = undefined
|
||||
-- in runM $ runResourceInIO foo
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... Ambiguous use of effect 'Lift'
|
||||
-- ...
|
||||
-- ... (Member (Lift IO) r0) ...
|
||||
-- ...
|
||||
-- ... Could not deduce: (Member Resource r1)
|
||||
-- ...
|
||||
--
|
||||
-- PROBLEM: This error is totally bogus. We forgot to give an argument to
|
||||
-- 'runResourceInIO'. For comparison, the standard error GHC gives in this case
|
||||
-- is significantly more helpful:
|
||||
--
|
||||
-- <interactive>:192:13: error:
|
||||
-- • Couldn't match expected type ‘Sem '[Lift m] a’
|
||||
-- with actual type ‘Sem (Resource : r0) a0 -> Sem r0 a0’
|
||||
-- • Probable cause: ‘runResourceInIO’ is applied to too few arguments
|
||||
-- In the second argument of ‘($)’, namely ‘runResourceInIO foo’
|
||||
-- In the expression: runM $ runResourceInIO foo
|
||||
-- In the expression:
|
||||
-- let
|
||||
-- foo :: Member Resource r => Sem r ()
|
||||
-- foo = undefined
|
||||
-- in runM $ runResourceInIO foo
|
||||
-- • Relevant bindings include
|
||||
-- it :: m a (bound at <interactive>:190:2)
|
||||
-- <interactive>:192:29: error:
|
||||
-- • Couldn't match expected type ‘Sem r0 x -> IO x’
|
||||
-- with actual type ‘Sem r1 ()’
|
||||
-- • In the first argument of ‘runResourceInIO’, namely ‘foo’
|
||||
-- In the second argument of ‘($)’, namely ‘runResourceInIO foo’
|
||||
-- In the expression: runM $ runResourceInIO foo
|
||||
--
|
||||
--
|
||||
-- SOLUTION: Honestly I'm not sure!
|
||||
missingArgumentToRunResourceInIO'WRONG = ()
|
||||
|
||||
|
||||
|
||||
spec :: Spec
|
||||
spec = parallel $ describe "Error messages" $ it "should pass the doctest" $ doctest
|
||||
[ "-isrc/"
|
||||
@ -186,7 +21,7 @@ spec = parallel $ describe "Error messages" $ it "should pass the doctest" $ doc
|
||||
, "-XTypeFamilies"
|
||||
, "-XUnicodeSyntax"
|
||||
|
||||
, "test/DoctestSpec.hs"
|
||||
, "test/TypeErrors.hs"
|
||||
|
||||
-- Modules that are explicitly imported for this test must be listed here
|
||||
, "src/Polysemy.hs"
|
||||
|
||||
167
test/TypeErrors.hs
Normal file
167
test/TypeErrors.hs
Normal file
@ -0,0 +1,167 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
|
||||
module TypeErrors where
|
||||
|
||||
-- $setup
|
||||
-- >>> default ()
|
||||
-- >>> :m +Polysemy
|
||||
-- >>> :m +Polysemy.Output
|
||||
-- >>> :m +Polysemy.Reader
|
||||
-- >>> :m +Polysemy.Resource
|
||||
-- >>> :m +Polysemy.State
|
||||
-- >>> :m +Polysemy.Trace
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
-- foo :: Sem r ()
|
||||
-- foo = put ()
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... Ambiguous use of effect 'State'
|
||||
-- ...
|
||||
-- ... (Member (State ()) r) ...
|
||||
-- ...
|
||||
ambiguousMonoState = ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
-- foo :: Sem r ()
|
||||
-- foo = put 5
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... Ambiguous use of effect 'State'
|
||||
-- ...
|
||||
-- ... (Member (State s0) r) ...
|
||||
-- ...
|
||||
-- ... 's0' directly...
|
||||
-- ...
|
||||
ambiguousPolyState = ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- TODO(sandy): should this mention 'Reader i' or just 'Reader'?
|
||||
--
|
||||
-- >>> :{
|
||||
-- interpret @Reader $ \case
|
||||
-- Ask -> undefined
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... 'Reader i' is higher-order, but 'interpret' can help only
|
||||
-- ... with first-order effects.
|
||||
-- ...
|
||||
-- ... 'interpretH' instead.
|
||||
-- ...
|
||||
interpretBadFirstOrder = ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
-- runFoldMapOutput
|
||||
-- :: forall o m r a
|
||||
-- . Monoid m
|
||||
-- => (o -> m)
|
||||
-- -> Sem (Output o ': r) a
|
||||
-- -> Sem r (m, a)
|
||||
-- runFoldMapOutput f = runState mempty . reinterpret $ \case
|
||||
-- Output o -> modify (<> f o)
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... Probable cause: ...reinterpret... is applied to too few arguments
|
||||
-- ...
|
||||
tooFewArgumentsReinterpret = ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
-- let reinterpretScrub :: Sem (Output Int ': m) a -> Sem (State Bool ': Trace ': m) a
|
||||
-- reinterpretScrub = undefined
|
||||
-- foo :: Sem '[Output Int] ()
|
||||
-- foo = pure ()
|
||||
-- foo' = reinterpretScrub foo
|
||||
-- foo'' = runState True foo'
|
||||
-- foo''' = runTraceIO foo''
|
||||
-- in runM foo'''
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... Ambiguous use of effect 'Lift'
|
||||
-- ...
|
||||
-- ... add (Member (Lift IO) '[]) ...
|
||||
-- ...
|
||||
--
|
||||
-- PROBLEM: We're trying to run more effects than exist in the eff row. This is
|
||||
-- indeed a problem, but the error message isn't helpful.
|
||||
--
|
||||
-- SOLUTION: Add a special case to `AmbiguousSend` when `r ~ '[]`.
|
||||
runningTooManyEffects'WRONG = ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
-- foo :: Sem (State Int ': r) ()
|
||||
-- foo = put ()
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... Ambiguous use of effect 'State'
|
||||
-- ...
|
||||
-- ... (Member (State ()) State Int : r) ...
|
||||
-- ...
|
||||
--
|
||||
-- PROBLEM: There should be parentheses around `State Int : r`
|
||||
--
|
||||
-- SOLUTION: Emit parens only when the effect row is of the form `e1 ': ...`
|
||||
missingParens'WRONG = ()
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- >>> :{
|
||||
-- let foo :: Member Resource r => Sem r ()
|
||||
-- foo = undefined
|
||||
-- in runM $ runResourceInIO foo
|
||||
-- :}
|
||||
-- ...
|
||||
-- ... Ambiguous use of effect 'Lift'
|
||||
-- ...
|
||||
-- ... (Member (Lift IO) r0) ...
|
||||
-- ...
|
||||
-- ... Could not deduce: (Member Resource r1)
|
||||
-- ...
|
||||
--
|
||||
-- PROBLEM: This error is totally bogus. We forgot to give an argument to
|
||||
-- 'runResourceInIO'. For comparison, the standard error GHC gives in this case
|
||||
-- is significantly more helpful:
|
||||
--
|
||||
-- <interactive>:192:13: error:
|
||||
-- • Couldn't match expected type ‘Sem '[Lift m] a’
|
||||
-- with actual type ‘Sem (Resource : r0) a0 -> Sem r0 a0’
|
||||
-- • Probable cause: ‘runResourceInIO’ is applied to too few arguments
|
||||
-- In the second argument of ‘($)’, namely ‘runResourceInIO foo’
|
||||
-- In the expression: runM $ runResourceInIO foo
|
||||
-- In the expression:
|
||||
-- let
|
||||
-- foo :: Member Resource r => Sem r ()
|
||||
-- foo = undefined
|
||||
-- in runM $ runResourceInIO foo
|
||||
-- • Relevant bindings include
|
||||
-- it :: m a (bound at <interactive>:190:2)
|
||||
-- <interactive>:192:29: error:
|
||||
-- • Couldn't match expected type ‘Sem r0 x -> IO x’
|
||||
-- with actual type ‘Sem r1 ()’
|
||||
-- • In the first argument of ‘runResourceInIO’, namely ‘foo’
|
||||
-- In the second argument of ‘($)’, namely ‘runResourceInIO foo’
|
||||
-- In the expression: runM $ runResourceInIO foo
|
||||
--
|
||||
--
|
||||
-- SOLUTION: Honestly I'm not sure!
|
||||
missingArgumentToRunResourceInIO'WRONG = ()
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user