Test with 3 latest versions of GHC, update Ormolu

This commit is contained in:
Mark Karpov 2021-11-11 19:03:22 +01:00
parent 9a71a45399
commit d5556790fa
7 changed files with 74 additions and 85 deletions

View File

@ -12,25 +12,25 @@ jobs:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v2.3.4
- uses: mrkkrp/ormolu-action@v2
- uses: mrkkrp/ormolu-action@v5
build:
runs-on: ubuntu-latest
needs: ormolu
strategy:
matrix:
cabal: ["3.4"]
ghc: ["8.8.4", "8.10.5", "9.0.1"]
cabal: ["3.6"]
ghc: ["8.10.7", "9.0.1", "9.2.1"]
env:
CONFIG: "--enable-tests --enable-benchmarks --flags=dev"
steps:
- uses: actions/checkout@v2.3.4
- uses: haskell/actions/setup@v1.2
- uses: haskell/actions/setup@v1.2.7
id: setup-haskell-cabal
with:
ghc-version: ${{ matrix.ghc }}
cabal-version: ${{ matrix.cabal }}
- run: cabal v2-update
- run: cabal v2-freeze $CONFIG
- run: cabal update
- run: cabal freeze $CONFIG
- uses: actions/cache@v2.1.3
with:
path: |
@ -42,9 +42,9 @@ jobs:
- run: cabal format
- run: pushd megaparsec-tests && cabal format && popd
- run: git diff --exit-code --color=always
- run: cabal v2-build all $CONFIG
- run: cabal v2-test all $CONFIG
- run: cabal v2-haddock megaparsec $CONFIG
- run: cabal v2-haddock megaparsec-tests $CONFIG
- run: cabal v2-sdist
- run: pushd megaparsec-tests && cabal v2-sdist && popd
- run: cabal build all $CONFIG
- run: cabal test all $CONFIG
- run: cabal haddock megaparsec $CONFIG
- run: cabal haddock megaparsec-tests $CONFIG
- run: cabal sdist
- run: pushd megaparsec-tests && cabal sdist && popd

View File

@ -498,7 +498,7 @@ messageItemsPretty ::
messageItemsPretty prefix ts
| E.null ts = ""
| otherwise =
prefix <> (orList . NE.fromList . E.toAscList) ts <> "\n"
prefix <> (orList . NE.fromList . E.toAscList) ts <> "\n"
-- | Print a pretty list where items are separated with commas and the word
-- “or” according to the rules of English punctuation.

View File

@ -423,17 +423,17 @@ reachOffset'
w = unPos pstateTabWidth
in if
| ch == newlineTok ->
St
(SourcePos n (l <> pos1) pos1)
id
St
(SourcePos n (l <> pos1) pos1)
id
| ch == tabTok ->
St
(SourcePos n l (mkPos $ c' + w - ((c' - 1) `rem` w)))
(g . (fromTok ch :))
St
(SourcePos n l (mkPos $ c' + w - ((c' - 1) `rem` w)))
(g . (fromTok ch :))
| otherwise ->
St
(SourcePos n l (c <> pos1))
(g . (fromTok ch :))
St
(SourcePos n l (c <> pos1))
(g . (fromTok ch :))
{-# INLINE reachOffset' #-}
-- | Like 'reachOffset'' but for 'reachOffsetNoLine'.
@ -474,11 +474,11 @@ reachOffsetNoLine'
w = unPos pstateTabWidth
in if
| ch == newlineTok ->
SourcePos n (l <> pos1) pos1
SourcePos n (l <> pos1) pos1
| ch == tabTok ->
SourcePos n l (mkPos $ c' + w - ((c' - 1) `rem` w))
SourcePos n l (mkPos $ c' + w - ((c' - 1) `rem` w))
| otherwise ->
SourcePos n l (c <> pos1)
SourcePos n l (c <> pos1)
{-# INLINE reachOffsetNoLine' #-}
-- | Like 'BL.splitAt' but accepts the index as an 'Int'.

View File

@ -1,11 +1,11 @@
cabal-version: 1.18
cabal-version: 2.4
name: megaparsec-tests
version: 9.2.0
license: BSD2
license: BSD-2-Clause
license-file: LICENSE.md
maintainer: Mark Karpov <markkarpov92@gmail.com>
author: Megaparsec contributors
tested-with: ghc ==8.8.4 ghc ==8.10.4 ghc ==9.0.1
tested-with: ghc ==8.10.7 ghc ==9.0.1 ghc ==9.2.1
homepage: https://github.com/mrkkrp/megaparsec
bug-reports: https://github.com/mrkkrp/megaparsec/issues
synopsis: Test utilities and the test suite of Megaparsec

View File

@ -120,13 +120,13 @@ spec = do
sp = void (symbol sc sbla <* C.eol)
if
| col0 <= pos1 ->
prs p s `shouldFailWith` errFancy 0 (ii GT pos1 col0)
prs p s `shouldFailWith` errFancy 0 (ii GT pos1 col0)
| col1 /= col0 ->
prs p s `shouldFailWith` errFancy (getIndent l1 + g 1) (ii EQ col0 col1)
prs p s `shouldFailWith` errFancy (getIndent l1 + g 1) (ii EQ col0 col1)
| col2 <= col0 ->
prs p s `shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col0 col2)
prs p s `shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col0 col2)
| otherwise ->
prs p s `shouldParse` ()
prs p s `shouldParse` ()
describe "nonIdented" $
it "works as intended" $
@ -166,32 +166,32 @@ spec = do
ib' = mkPos (fromIntegral ib)
if
| col1 <= col0 ->
prs p s
`shouldFailWith` err (getIndent l1 + g 1) (utok (head sblb) <> eeof)
prs p s
`shouldFailWith` err (getIndent l1 + g 1) (utok (head sblb) <> eeof)
| isJust mn && col1 /= ib' ->
prs p s
`shouldFailWith` errFancy (getIndent l1 + g 1) (ii EQ ib' col1)
prs p s
`shouldFailWith` errFancy (getIndent l1 + g 1) (ii EQ ib' col1)
| col2 <= col1 ->
prs p s
`shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col1 col2)
prs p s
`shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col1 col2)
| col3 == col2 ->
prs p s
`shouldFailWith` err (getIndent l3 + g 3) (utoks sblb <> etoks sblc <> eeof)
prs p s
`shouldFailWith` err (getIndent l3 + g 3) (utoks sblb <> etoks sblc <> eeof)
| col3 <= col0 ->
prs p s
`shouldFailWith` err (getIndent l3 + g 3) (utok (head sblb) <> eeof)
prs p s
`shouldFailWith` err (getIndent l3 + g 3) (utok (head sblb) <> eeof)
| col3 < col1 ->
prs p s
`shouldFailWith` errFancy (getIndent l3 + g 3) (ii EQ col1 col3)
prs p s
`shouldFailWith` errFancy (getIndent l3 + g 3) (ii EQ col1 col3)
| col3 > col1 ->
prs p s
`shouldFailWith` errFancy (getIndent l3 + g 3) (ii EQ col2 col3)
prs p s
`shouldFailWith` errFancy (getIndent l3 + g 3) (ii EQ col2 col3)
| col4 <= col3 ->
prs p s
`shouldFailWith` errFancy (getIndent l4 + g 4) (ii GT col3 col4)
prs p s
`shouldFailWith` errFancy (getIndent l4 + g 4) (ii GT col3 col4)
| otherwise ->
prs p s
`shouldParse` (sbla, [(sblb, [sblc]), (sblb, [sblc])])
prs p s
`shouldParse` (sbla, [(sblb, [sblc]), (sblb, [sblc])])
it "IndentMany works as intended (newline at the end)" $
property $
forAll ((<>) <$> mkIndent sbla 0 <*> mkWhiteSpaceNl) $ \s -> do
@ -267,11 +267,11 @@ spec = do
(end0, end1) = (getEnd l0, getEnd l1)
if
| end0 && col1 <= col0 ->
prs p s
`shouldFailWith` errFancy (getIndent l1 + g 1) (ii GT col0 col1)
prs p s
`shouldFailWith` errFancy (getIndent l1 + g 1) (ii GT col0 col1)
| end1 && col2 <= col0 ->
prs p s
`shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col0 col2)
prs p s
`shouldFailWith` errFancy (getIndent l2 + g 2) (ii GT col0 col2)
| otherwise -> prs p s `shouldParse` (sbla, sblb, sblc)
describe "charLiteral" $ do

View File

@ -26,7 +26,6 @@ import Data.Char (isLetter, toUpper)
import Data.Foldable (asum)
import Data.List (isPrefixOf)
import qualified Data.List as DL
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Semigroup
import qualified Data.Set as E
@ -220,17 +219,15 @@ spec = do
describe "many" $ do
context "when stream begins with things argument of many parses" $
it "they are parsed" $
property $ \a' b' c' -> do
let [a, b, c] = getNonNegative <$> [a', b', c']
p = many (char 'a')
property $ \(NonNegative a) (NonNegative b) (NonNegative c) -> do
let p = many (char 'a')
s = abcRow a b c
prs p s `shouldParse` replicate a 'a'
prs' p s `succeedsLeaving` drop a s
context "when stream does not begin with thing argument of many parses" $
it "does nothing" $
property $ \a' b' c' -> do
let [a, b, c] = getNonNegative <$> [a', b', c']
p = many (char 'd')
property $ \(NonNegative a) (NonNegative b) (NonNegative c) -> do
let p = many (char 'd')
s = abcRow a b c
prs p s `shouldParse` ""
prs' p s `succeedsLeaving` s
@ -249,9 +246,8 @@ spec = do
(utok 'c' <> etok 'a' <> etok 'b' <> eeof)
context "when the argument parser succeeds without consuming" $
it "is run nevertheless" $
property $ \n' -> do
let n = getSmall (getNonNegative n') :: Integer
p = void . many $ do
property $ \(NonNegative (Small n)) -> do
let p = void . many $ do
x <- S.get
if x < n then S.modify (+ 1) else empty
v :: S.State Integer (Either (ParseErrorBundle String Void) ())
@ -261,18 +257,15 @@ spec = do
describe "some" $ do
context "when stream begins with things argument of some parses" $
it "they are parsed" $
property $ \a' b' c' -> do
let a = getPositive a'
[b, c] = getNonNegative <$> [b', c']
p = some (char 'a')
property $ \(Positive a) (NonNegative b) (NonNegative c) -> do
let p = some (char 'a')
s = abcRow a b c
prs p s `shouldParse` replicate a 'a'
prs' p s `succeedsLeaving` drop a s
context "when stream does not begin with thing argument of some parses" $
it "signals correct parse error" $
property $ \a' b' c' -> do
let [a, b, c] = getNonNegative <$> [a', b', c']
p = some (char 'd')
property $ \(NonNegative a) (NonNegative b) (NonNegative c) -> do
let p = some (char 'd')
s = abcRow a b c ++ "g"
prs p s `shouldFailWith` err 0 (utok (head s) <> etok 'd')
prs' p s `failsLeaving` s
@ -801,7 +794,7 @@ spec = do
grs p s (`shouldFailWith` err 0 mempty)
grs' p s (`failsLeaving` s)
it "works in complex situations too" $
property $ \a' b' c' -> do
property $ \(NonNegative a) (NonNegative b) (NonNegative c) -> do
let p :: MonadParsec Void String m => m (Either (ParseError String Void) String)
p =
let g = count' 1 3 . char
@ -811,7 +804,6 @@ spec = do
v (Left m) _ = Left m
ma = if a < 3 then etok 'a' else mempty
s = abcRow a b c
[a, b, c] = getNonNegative <$> [a', b', c']
f = flip shouldFailWith
z = flip shouldParse
r
@ -1257,9 +1249,8 @@ spec = do
describe "oneOf" $ do
context "when stream begins with one of specified characters" $
it "parses the character" $
property $ \chs' n s -> do
let chs = getNonEmpty chs'
ch = chs !! (getNonNegative n `rem` length chs)
property $ \(NonEmpty chs) (NonNegative n) s -> do
let ch = chs !! (n `rem` length chs)
s' = ch : s
grs (oneOf chs) s' (`shouldParse` ch)
grs' (oneOf chs) s' (`succeedsLeaving` s)
@ -1285,9 +1276,8 @@ spec = do
grs' (noneOf chs) s' (`succeedsLeaving` s)
context "when stream begins with one of specified characters" $
it "signals correct parse error" $
property $ \chs' n s -> do
let chs = getNonEmpty chs'
ch = chs !! (getNonNegative n `rem` length chs)
property $ \(NonEmpty chs) (NonNegative n) s -> do
let ch = chs !! (n `rem` length chs)
s' = ch : s
grs (noneOf chs) s' (`shouldFailWith` err 0 (utok ch))
grs' (noneOf chs) s' (`failsLeaving` s')
@ -1420,9 +1410,8 @@ spec = do
describe "notFollowedBy" $
it "generally works" $
property $ \a' b' c' -> do
property $ \(NonNegative a) (NonNegative b) (NonNegative c) -> do
let p = many (char =<< ask) <* notFollowedBy eof <* many anySingle
[a, b, c] = getNonNegative <$> [a', b', c']
s = abcRow a b c
if b > 0 || c > 0
then prs (runReaderT p 'a') s `shouldParse` replicate a 'a'
@ -1767,7 +1756,7 @@ eqParser p1 p2 s = runParser p1 "" s == runParser p2 "" s
mkBundle ::
State s e ->
NonEmpty (ParseError s e) ->
NE.NonEmpty (ParseError s e) ->
ParseErrorBundle s e
mkBundle s es =
ParseErrorBundle

View File

@ -1,7 +1,7 @@
cabal-version: 1.18
cabal-version: 2.4
name: megaparsec
version: 9.2.0
license: BSD2
license: BSD-2-Clause
license-file: LICENSE.md
maintainer: Mark Karpov <markkarpov92@gmail.com>
author:
@ -9,7 +9,7 @@ author:
Paolo Martini <paolo@nemail.it>,
Daan Leijen <daan@microsoft.com>
tested-with: ghc ==8.8.4 ghc ==8.10.5 ghc ==9.0.1
tested-with: ghc ==8.10.7 ghc ==9.0.1 ghc ==9.2.1
homepage: https://github.com/mrkkrp/megaparsec
bug-reports: https://github.com/mrkkrp/megaparsec/issues
synopsis: Monadic parser combinators