mirror of
https://github.com/serokell/xrefcheck.git
synced 2024-08-17 17:40:50 +03:00
[#135] CI: add stylish-haskell and shellcheck
Problem: We should add stylish-haskell and shellcheck to our pipline. Solution: Add stylish-haskell and shellcheck. Use stylish-haskell on repo.
This commit is contained in:
parent
1543744a0c
commit
c94ddfcf7d
@ -6,6 +6,12 @@ steps:
|
|||||||
- command: nix-build ci.nix -A trailing-whitespace-check
|
- command: nix-build ci.nix -A trailing-whitespace-check
|
||||||
label: Check trailing whitespaces
|
label: Check trailing whitespaces
|
||||||
|
|
||||||
|
- label: shellcheck
|
||||||
|
command: nix run -f ci.nix pkgs.shellcheck -c find . -name '*.sh' -exec shellcheck {} +
|
||||||
|
|
||||||
|
- label: stylish
|
||||||
|
command: nix run -f ci.nix pkgs.gnumake pkgs-stylish.stylish-haskell -c ./scripts/validate-stylish.sh
|
||||||
|
|
||||||
- command: nix-build ci.nix -A xrefcheck-lib-and-tests
|
- command: nix-build ci.nix -A xrefcheck-lib-and-tests
|
||||||
label: Library and tests
|
label: Library and tests
|
||||||
|
|
||||||
|
@ -44,7 +44,6 @@ language_extensions:
|
|||||||
- MultiParamTypeClasses
|
- MultiParamTypeClasses
|
||||||
- MultiWayIf
|
- MultiWayIf
|
||||||
- NamedFieldPuns
|
- NamedFieldPuns
|
||||||
- NoImplicitPrelude
|
|
||||||
- NumericUnderscores
|
- NumericUnderscores
|
||||||
- OverloadedLabels
|
- OverloadedLabels
|
||||||
- OverloadedStrings
|
- OverloadedStrings
|
||||||
|
5
Makefile
5
Makefile
@ -2,7 +2,7 @@
|
|||||||
#
|
#
|
||||||
# SPDX-License-Identifier: MPL-2.0
|
# SPDX-License-Identifier: MPL-2.0
|
||||||
|
|
||||||
.PHONY: xrefcheck test lint clean bats all
|
.PHONY: xrefcheck test lint stylish clean bats all
|
||||||
|
|
||||||
# Build target from the common utility Makefile
|
# Build target from the common utility Makefile
|
||||||
MAKEU = $(MAKE) -C make/
|
MAKEU = $(MAKE) -C make/
|
||||||
@ -33,6 +33,9 @@ clean:
|
|||||||
lint:
|
lint:
|
||||||
hlint .
|
hlint .
|
||||||
|
|
||||||
|
stylish:
|
||||||
|
find . -name '.stack-work' -prune -o -name '.dist-newstyle' -prune -o -name '*.hs' -exec stylish-haskell -i '{}' \;
|
||||||
|
|
||||||
####################################
|
####################################
|
||||||
# Individual test suites
|
# Individual test suites
|
||||||
|
|
||||||
|
3
ci.nix
3
ci.nix
@ -24,6 +24,9 @@ rec {
|
|||||||
};
|
};
|
||||||
};
|
};
|
||||||
|
|
||||||
|
# TODO: drop this when `serokell/nixpkgs` acquires stylish-haskell >= 0.13.0.0.
|
||||||
|
pkgs-stylish = import sources.nixpkgs-stylish {};
|
||||||
|
|
||||||
xrefcheck-lib-and-tests = (import ./xrefcheck.nix { linux = true; });
|
xrefcheck-lib-and-tests = (import ./xrefcheck.nix { linux = true; });
|
||||||
xrefcheck-static = (import ./xrefcheck.nix { linux-static = true; }).components.exes.xrefcheck;
|
xrefcheck-static = (import ./xrefcheck.nix { linux-static = true; }).components.exes.xrefcheck;
|
||||||
xrefcheck-windows = (import ./xrefcheck.nix { windows = true; }).components.exes.xrefcheck;
|
xrefcheck-windows = (import ./xrefcheck.nix { windows = true; }).components.exes.xrefcheck;
|
||||||
|
@ -15,7 +15,8 @@ import Test.Tasty (TestTree, askOption, testGroup)
|
|||||||
import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))
|
import Test.Tasty.HUnit (assertBool, assertFailure, testCase, (@?=))
|
||||||
import Test.Tasty.Options as Tasty (IsOption (..), OptionDescription (Option), safeRead)
|
import Test.Tasty.Options as Tasty (IsOption (..), OptionDescription (Option), safeRead)
|
||||||
|
|
||||||
import Xrefcheck.Config (Config' (cVerification), VerifyConfig, VerifyConfig' (vcIgnoreRefs), defConfig)
|
import Xrefcheck.Config
|
||||||
|
(Config' (cVerification), VerifyConfig, VerifyConfig' (vcIgnoreRefs), defConfig)
|
||||||
import Xrefcheck.Core (Flavor (GitHub))
|
import Xrefcheck.Core (Flavor (GitHub))
|
||||||
import Xrefcheck.Verify
|
import Xrefcheck.Verify
|
||||||
(VerifyError (..), VerifyResult (VerifyResult), checkExternalResource, verifyErrors)
|
(VerifyError (..), VerifyResult (VerifyResult), checkExternalResource, verifyErrors)
|
||||||
|
@ -35,6 +35,18 @@
|
|||||||
"url": "https://github.com/serokell/nixpkgs/archive/1714a2ead1a18678afa3cbf75dff3f024c579061.tar.gz",
|
"url": "https://github.com/serokell/nixpkgs/archive/1714a2ead1a18678afa3cbf75dff3f024c579061.tar.gz",
|
||||||
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
|
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
|
||||||
},
|
},
|
||||||
|
"nixpkgs-stylish": {
|
||||||
|
"branch": "master",
|
||||||
|
"description": "Nix Packages collection",
|
||||||
|
"homepage": "",
|
||||||
|
"owner": "NixOS",
|
||||||
|
"repo": "nixpkgs",
|
||||||
|
"rev": "19574af0af3ffaf7c9e359744ed32556f34536bd",
|
||||||
|
"sha256": "0v3c4r8v40jimicdxqvxnzmdypnafm2baam7z131zk6ljhb8jpg9",
|
||||||
|
"type": "tarball",
|
||||||
|
"url": "https://github.com/NixOS/nixpkgs/archive/19574af0af3ffaf7c9e359744ed32556f34536bd.tar.gz",
|
||||||
|
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
|
||||||
|
},
|
||||||
"serokell.nix": {
|
"serokell.nix": {
|
||||||
"branch": "master",
|
"branch": "master",
|
||||||
"description": "Serokell Nix infrastructure library",
|
"description": "Serokell Nix infrastructure library",
|
||||||
|
30
scripts/validate-stylish.sh
Executable file
30
scripts/validate-stylish.sh
Executable file
@ -0,0 +1,30 @@
|
|||||||
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
|
# SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
|
||||||
|
#
|
||||||
|
# SPDX-License-Identifier: MPL-2.0
|
||||||
|
|
||||||
|
# This script verifies that the repo adheres to the stylish-haskell rules.
|
||||||
|
#
|
||||||
|
# It does this by running `make stylish` on the repo and checking
|
||||||
|
# that no files were affected.
|
||||||
|
|
||||||
|
set -euo pipefail
|
||||||
|
|
||||||
|
make stylish
|
||||||
|
|
||||||
|
# Note: we temporarily disable `-e`;
|
||||||
|
# otherwise the script would exit when `git diff` returns 1.
|
||||||
|
set +e
|
||||||
|
diff=$(git diff --exit-code --name-only)
|
||||||
|
exitCode=$?
|
||||||
|
set -e
|
||||||
|
|
||||||
|
if [ "$exitCode" != 0 ]; then
|
||||||
|
echo "Found files that do not adhere to stylish-haskell."
|
||||||
|
echo "Run 'make stylish' on the repository to fix this."
|
||||||
|
echo ""
|
||||||
|
echo "Offending files:"
|
||||||
|
echo "$diff"
|
||||||
|
exit 1
|
||||||
|
fi
|
@ -26,9 +26,9 @@ import Data.List qualified as L
|
|||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
import Data.Version (showVersion)
|
import Data.Version (showVersion)
|
||||||
import Options.Applicative
|
import Options.Applicative
|
||||||
(Mod, OptionFields, Parser, ReadM, auto, command, eitherReader, execParser, flag',
|
(Mod, OptionFields, Parser, ReadM, auto, command, eitherReader, execParser, flag', footerDoc,
|
||||||
footerDoc, fullDesc, help, helpDoc, helper, hsubparser, info, infoOption, long, metavar, option,
|
fullDesc, help, helpDoc, helper, hsubparser, info, infoOption, long, metavar, option, progDesc,
|
||||||
progDesc, short, strOption, switch, value)
|
short, strOption, switch, value)
|
||||||
import Options.Applicative.Help.Pretty (Doc, displayS, fill, fillSep, indent, renderPretty, text)
|
import Options.Applicative.Help.Pretty (Doc, displayS, fill, fillSep, indent, renderPretty, text)
|
||||||
import Options.Applicative.Help.Pretty qualified as Pretty
|
import Options.Applicative.Help.Pretty qualified as Pretty
|
||||||
|
|
||||||
@ -36,8 +36,8 @@ import Paths_xrefcheck (version)
|
|||||||
import Xrefcheck.Config (VerifyConfig, VerifyConfig' (..))
|
import Xrefcheck.Config (VerifyConfig, VerifyConfig' (..))
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
import Xrefcheck.Scan
|
import Xrefcheck.Scan
|
||||||
import Xrefcheck.Util (normaliseWithNoTrailing)
|
|
||||||
import Xrefcheck.System (RelGlobPattern (..))
|
import Xrefcheck.System (RelGlobPattern (..))
|
||||||
|
import Xrefcheck.Util (normaliseWithNoTrailing)
|
||||||
|
|
||||||
modeReadM :: ReadM VerifyMode
|
modeReadM :: ReadM VerifyMode
|
||||||
modeReadM = eitherReader $ \s ->
|
modeReadM = eitherReader $ \s ->
|
||||||
|
@ -19,7 +19,8 @@ import Xrefcheck.Config
|
|||||||
overrideConfig)
|
overrideConfig)
|
||||||
import Xrefcheck.Core (Flavor (..))
|
import Xrefcheck.Core (Flavor (..))
|
||||||
import Xrefcheck.Progress (allowRewrite)
|
import Xrefcheck.Progress (allowRewrite)
|
||||||
import Xrefcheck.Scan (FormatsSupport, scanRepo, specificFormatsSupport, ScanResult (..), ScanError (..))
|
import Xrefcheck.Scan
|
||||||
|
(FormatsSupport, ScanError (..), ScanResult (..), scanRepo, specificFormatsSupport)
|
||||||
import Xrefcheck.Scanners.Markdown (markdownSupport)
|
import Xrefcheck.Scanners.Markdown (markdownSupport)
|
||||||
import Xrefcheck.System (askWithinCI)
|
import Xrefcheck.System (askWithinCI)
|
||||||
import Xrefcheck.Verify (verifyErrors, verifyRepo)
|
import Xrefcheck.Verify (verifyErrors, verifyRepo)
|
||||||
|
@ -7,7 +7,7 @@
|
|||||||
|
|
||||||
module Xrefcheck.Config where
|
module Xrefcheck.Config where
|
||||||
|
|
||||||
import qualified Universum.Unsafe as Unsafe
|
import Universum.Unsafe qualified as Unsafe
|
||||||
|
|
||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
@ -20,17 +20,17 @@ import Data.Yaml (FromJSON (..), decodeEither', prettyPrintParseException, withT
|
|||||||
import Instances.TH.Lift ()
|
import Instances.TH.Lift ()
|
||||||
import Text.Regex.TDFA qualified as R
|
import Text.Regex.TDFA qualified as R
|
||||||
import Text.Regex.TDFA.ByteString ()
|
import Text.Regex.TDFA.ByteString ()
|
||||||
|
import Text.Regex.TDFA.Common
|
||||||
import Text.Regex.TDFA.Text qualified as R
|
import Text.Regex.TDFA.Text qualified as R
|
||||||
|
|
||||||
import Time (KnownRatName, Second, Time(..), unitsP)
|
import Time (KnownRatName, Second, Time (..), unitsP)
|
||||||
|
|
||||||
|
import Xrefcheck.Config.Default
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
import Xrefcheck.Scan
|
import Xrefcheck.Scan
|
||||||
import Xrefcheck.Scanners.Markdown
|
import Xrefcheck.Scanners.Markdown
|
||||||
import Xrefcheck.System (RelGlobPattern, normaliseGlobPattern)
|
import Xrefcheck.System (RelGlobPattern, normaliseGlobPattern)
|
||||||
import Xrefcheck.Util (aesonConfigOption, postfixFields, (-:), Field)
|
import Xrefcheck.Util (Field, aesonConfigOption, postfixFields, (-:))
|
||||||
import Xrefcheck.Config.Default
|
|
||||||
import Text.Regex.TDFA.Common
|
|
||||||
|
|
||||||
-- | Type alias for Config' with all required fields.
|
-- | Type alias for Config' with all required fields.
|
||||||
type Config = Config' Identity
|
type Config = Config' Identity
|
||||||
|
@ -25,10 +25,10 @@ import System.FilePath (isPathSeparator, pathSeparator)
|
|||||||
import Text.Numeral.Roman (toRoman)
|
import Text.Numeral.Roman (toRoman)
|
||||||
import Time (Second, Time)
|
import Time (Second, Time)
|
||||||
|
|
||||||
import Xrefcheck.Progress
|
|
||||||
import Xrefcheck.Util
|
|
||||||
import Data.DList (DList)
|
import Data.DList (DList)
|
||||||
import Data.DList qualified as DList
|
import Data.DList qualified as DList
|
||||||
|
import Xrefcheck.Progress
|
||||||
|
import Xrefcheck.Util
|
||||||
|
|
||||||
-----------------------------------------------------------
|
-----------------------------------------------------------
|
||||||
-- Types
|
-- Types
|
||||||
|
@ -11,13 +11,13 @@ module Xrefcheck.Orphans () where
|
|||||||
|
|
||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as C
|
import Data.ByteString.Char8 qualified as C
|
||||||
|
|
||||||
import Fmt (Buildable (..), unlinesF, (+|), (|+))
|
import Fmt (Buildable (..), unlinesF, (+|), (|+))
|
||||||
import Network.FTP.Client
|
import Network.FTP.Client
|
||||||
(FTPException (..), FTPMessage (..), FTPResponse (..), ResponseStatus (..))
|
(FTPException (..), FTPMessage (..), FTPResponse (..), ResponseStatus (..))
|
||||||
import Text.URI (RText, unRText)
|
import Text.URI (RText, unRText)
|
||||||
import URI.ByteString (URIParseError (..), SchemaError (..))
|
import URI.ByteString (SchemaError (..), URIParseError (..))
|
||||||
|
|
||||||
instance ToString (RText t) where
|
instance ToString (RText t) where
|
||||||
toString = toString . unRText
|
toString = toString . unRText
|
||||||
|
@ -22,19 +22,19 @@ module Xrefcheck.Scan
|
|||||||
|
|
||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import Data.Aeson(FromJSON (..), genericParseJSON)
|
import Data.Aeson (FromJSON (..), genericParseJSON)
|
||||||
import Data.Foldable qualified as F
|
import Data.Foldable qualified as F
|
||||||
import Data.Map qualified as M
|
import Data.Map qualified as M
|
||||||
import Fmt (Buildable (..), (+|), (|+), nameF)
|
import Fmt (Buildable (..), nameF, (+|), (|+))
|
||||||
import System.Console.Pretty (Pretty(..), Style (..))
|
import System.Console.Pretty (Pretty (..), Style (..))
|
||||||
import System.Directory (doesDirectoryExist)
|
import System.Directory (doesDirectoryExist)
|
||||||
import System.Directory.Tree qualified as Tree
|
import System.Directory.Tree qualified as Tree
|
||||||
import System.FilePath (dropTrailingPathSeparator, takeDirectory, takeExtension, equalFilePath)
|
import System.FilePath (dropTrailingPathSeparator, equalFilePath, takeDirectory, takeExtension)
|
||||||
|
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
import Xrefcheck.Progress
|
import Xrefcheck.Progress
|
||||||
import Xrefcheck.System (readingSystem, RelGlobPattern, normaliseGlobPattern, matchesGlobPatterns)
|
import Xrefcheck.System (RelGlobPattern, matchesGlobPatterns, normaliseGlobPattern, readingSystem)
|
||||||
import Xrefcheck.Util (aesonConfigOption, normaliseWithNoTrailing, Field)
|
import Xrefcheck.Util (Field, aesonConfigOption, normaliseWithNoTrailing)
|
||||||
|
|
||||||
-- | Type alias for TraversalConfig' with all required fields.
|
-- | Type alias for TraversalConfig' with all required fields.
|
||||||
type TraversalConfig = TraversalConfig' Identity
|
type TraversalConfig = TraversalConfig' Identity
|
||||||
|
@ -16,12 +16,12 @@ import Universum
|
|||||||
|
|
||||||
import Data.Aeson (FromJSON (..), withText)
|
import Data.Aeson (FromJSON (..), withText)
|
||||||
import Data.Char qualified as C
|
import Data.Char qualified as C
|
||||||
|
import Data.Coerce (coerce)
|
||||||
import GHC.IO.Unsafe (unsafePerformIO)
|
import GHC.IO.Unsafe (unsafePerformIO)
|
||||||
import System.Directory (canonicalizePath)
|
import System.Directory (canonicalizePath)
|
||||||
import System.Environment (lookupEnv)
|
import System.Environment (lookupEnv)
|
||||||
import System.FilePath ((</>))
|
import System.FilePath ((</>))
|
||||||
import System.FilePath.Glob qualified as Glob
|
import System.FilePath.Glob qualified as Glob
|
||||||
import Data.Coerce (coerce)
|
|
||||||
import Xrefcheck.Util (normaliseWithNoTrailing)
|
import Xrefcheck.Util (normaliseWithNoTrailing)
|
||||||
|
|
||||||
-- | We can quite safely treat surrounding filesystem as frozen,
|
-- | We can quite safely treat surrounding filesystem as frozen,
|
||||||
|
@ -10,8 +10,8 @@ import Universum
|
|||||||
import Test.Tasty (TestTree, testGroup)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
import Test.Tasty.HUnit (testCase, (@?=))
|
import Test.Tasty.HUnit (testCase, (@?=))
|
||||||
|
|
||||||
import Xrefcheck.Core
|
|
||||||
import Test.Xrefcheck.Util
|
import Test.Xrefcheck.Util
|
||||||
|
import Xrefcheck.Core
|
||||||
|
|
||||||
test_anchorsInHeaders :: TestTree
|
test_anchorsInHeaders :: TestTree
|
||||||
test_anchorsInHeaders = testGroup "Anchors in headers"
|
test_anchorsInHeaders = testGroup "Anchors in headers"
|
||||||
|
@ -7,8 +7,8 @@ module Test.Xrefcheck.AnchorsSpec (test_anchors) where
|
|||||||
|
|
||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import Test.Tasty (testGroup, TestTree)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
import Test.Tasty.HUnit ((@?=), testCase)
|
import Test.Tasty.HUnit (testCase, (@?=))
|
||||||
|
|
||||||
import Test.Xrefcheck.Util
|
import Test.Xrefcheck.Util
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
|
@ -12,11 +12,11 @@ import Control.Exception qualified as E
|
|||||||
|
|
||||||
import Data.ByteString qualified as BS
|
import Data.ByteString qualified as BS
|
||||||
import Data.List (isInfixOf)
|
import Data.List (isInfixOf)
|
||||||
import Data.Yaml (decodeEither', ParseException (..))
|
import Data.Yaml (ParseException (..), decodeEither')
|
||||||
import Network.HTTP.Types (Status (..))
|
import Network.HTTP.Types (Status (..))
|
||||||
import Test.Tasty (TestTree, testGroup)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
|
import Test.Tasty.HUnit (assertFailure, testCase, (@?=))
|
||||||
import Test.Tasty.QuickCheck (ioProperty, testProperty)
|
import Test.Tasty.QuickCheck (ioProperty, testProperty)
|
||||||
import Test.Tasty.HUnit (testCase, assertFailure, (@?=))
|
|
||||||
|
|
||||||
|
|
||||||
import Xrefcheck.Config (Config, Config' (..), VerifyConfig' (..), defConfig, defConfigText)
|
import Xrefcheck.Config (Config, Config' (..), VerifyConfig' (..), defConfig, defConfigText)
|
||||||
|
@ -7,7 +7,7 @@ module Test.Xrefcheck.IgnoreAnnotationsSpec where
|
|||||||
|
|
||||||
import Universum
|
import Universum
|
||||||
|
|
||||||
import CMarkGFM (PosInfo(..))
|
import CMarkGFM (PosInfo (..))
|
||||||
import Test.Tasty (TestTree, testGroup)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
import Test.Tasty.HUnit (testCase, (@?=))
|
import Test.Tasty.HUnit (testCase, (@?=))
|
||||||
|
|
||||||
|
@ -9,13 +9,13 @@ import Universum
|
|||||||
|
|
||||||
import Data.Yaml (decodeEither')
|
import Data.Yaml (decodeEither')
|
||||||
import Test.Tasty (TestTree, testGroup)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
import Test.Tasty.HUnit (testCase, assertFailure)
|
import Test.Tasty.HUnit (assertFailure, testCase)
|
||||||
import Text.Regex.TDFA (Regex)
|
import Text.Regex.TDFA (Regex)
|
||||||
|
|
||||||
import Xrefcheck.Config
|
import Xrefcheck.Config
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
import Xrefcheck.Progress (allowRewrite)
|
import Xrefcheck.Progress (allowRewrite)
|
||||||
import Xrefcheck.Scan (scanRepo, specificFormatsSupport, ScanResult (..))
|
import Xrefcheck.Scan (ScanResult (..), scanRepo, specificFormatsSupport)
|
||||||
import Xrefcheck.Scanners.Markdown
|
import Xrefcheck.Scanners.Markdown
|
||||||
import Xrefcheck.Verify (VerifyError, VerifyResult, WithReferenceLoc (..), verifyErrors, verifyRepo)
|
import Xrefcheck.Verify (VerifyError, VerifyResult, WithReferenceLoc (..), verifyErrors, verifyRepo)
|
||||||
|
|
||||||
|
@ -11,15 +11,15 @@ import Control.Concurrent (forkIO, killThread)
|
|||||||
import Control.Exception qualified as E
|
import Control.Exception qualified as E
|
||||||
import Data.CaseInsensitive qualified as CI
|
import Data.CaseInsensitive qualified as CI
|
||||||
import Data.Map qualified as M
|
import Data.Map qualified as M
|
||||||
import Data.Time (addUTCTime, formatTime, getCurrentTime, defaultTimeLocale, rfc822DateFormat)
|
import Data.Time (addUTCTime, defaultTimeLocale, formatTime, getCurrentTime, rfc822DateFormat)
|
||||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||||
import Fmt (indentF, pretty, unlinesF)
|
import Fmt (indentF, pretty, unlinesF)
|
||||||
import Network.HTTP.Types (Status (..), ok200, serviceUnavailable503, tooManyRequests429)
|
import Network.HTTP.Types (Status (..), ok200, serviceUnavailable503, tooManyRequests429)
|
||||||
import Network.HTTP.Types.Header (hRetryAfter)
|
import Network.HTTP.Types.Header (hRetryAfter)
|
||||||
import Test.Tasty (testGroup, TestTree)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
import Test.Tasty.HUnit (testCase, (@?=), assertBool)
|
import Test.Tasty.HUnit (assertBool, testCase, (@?=))
|
||||||
import Time (sec, (-:-))
|
import Time (sec, (-:-))
|
||||||
import Web.Firefly (ToResponse (toResponse), route, run, getMethod)
|
import Web.Firefly (ToResponse (toResponse), getMethod, route, run)
|
||||||
|
|
||||||
import Xrefcheck.Config
|
import Xrefcheck.Config
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
@ -133,9 +133,9 @@ test_tooManyRequests = testGroup "429 response tests"
|
|||||||
callCount <- atomicModifyIORef' callCountRef $ \cc -> (cc + 1, cc)
|
callCount <- atomicModifyIORef' callCountRef $ \cc -> (cc + 1, cc)
|
||||||
atomicModifyIORef' infoReverseAccumulatorRef $ \lst ->
|
atomicModifyIORef' infoReverseAccumulatorRef $ \lst ->
|
||||||
( ( m
|
( ( m
|
||||||
, if | m == "GET" -> ok200
|
, if | m == "GET" -> ok200
|
||||||
| callCount == 0 -> tooManyRequests429
|
| callCount == 0 -> tooManyRequests429
|
||||||
| otherwise -> serviceUnavailable503
|
| otherwise -> serviceUnavailable503
|
||||||
) : lst
|
) : lst
|
||||||
, ()
|
, ()
|
||||||
)
|
)
|
||||||
|
@ -10,7 +10,7 @@ import Universum
|
|||||||
import Fmt (blockListF, pretty, unlinesF)
|
import Fmt (blockListF, pretty, unlinesF)
|
||||||
import System.Directory (doesFileExist)
|
import System.Directory (doesFileExist)
|
||||||
import Test.Tasty (TestTree, testGroup)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
import Test.Tasty.HUnit (testCase, assertFailure)
|
import Test.Tasty.HUnit (assertFailure, testCase)
|
||||||
|
|
||||||
import Xrefcheck.Config
|
import Xrefcheck.Config
|
||||||
import Xrefcheck.Core
|
import Xrefcheck.Core
|
||||||
|
Loading…
Reference in New Issue
Block a user