Skip to content

Commit

Permalink
Convert to use hedgehog and hspec
Browse files Browse the repository at this point in the history
  • Loading branch information
newhoggy committed Jan 23, 2020
1 parent 547c6fb commit 8717d63
Show file tree
Hide file tree
Showing 7 changed files with 509 additions and 328 deletions.
6 changes: 3 additions & 3 deletions .github/workflows/haskell.yml
Original file line number Diff line number Diff line change
Expand Up @@ -51,10 +51,10 @@ jobs:
run: cabal v2-configure

- name: Install dependencies
run: cabal v2-build --enable-tests --enable-benchmarks --write-ghc-environment-files=always --only-dependencies
run: cabal v2-build --enable-tests --enable-benchmarks --write-ghc-environment-files=always --test-show-details=direct --only-dependencies

- name: Build
run: cabal v2-build --enable-tests --enable-benchmarks --write-ghc-environment-files=always
run: cabal v2-build --enable-tests --enable-benchmarks --write-ghc-environment-files=always --test-show-details=direct

- name: Run tests
run: cabal v2-test --enable-tests --enable-benchmarks --write-ghc-environment-files=always
run: cabal v2-test --enable-tests --enable-benchmarks --write-ghc-environment-files=always --test-show-details=direct
189 changes: 189 additions & 0 deletions .stylish-haskell.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,189 @@
# stylish-haskell configuration file
# ==================================

# The stylish-haskell tool is mainly configured by specifying steps. These steps
# are a list, so they have an order, and one specific step may appear more than
# once (if needed). Each file is processed by these steps in the given order.
steps:
# Convert some ASCII sequences to their Unicode equivalents. This is disabled
# by default.
# - unicode_syntax:
# # In order to make this work, we also need to insert the UnicodeSyntax
# # language pragma. If this flag is set to true, we insert it when it's
# # not already present. You may want to disable it if you configure
# # language extensions using some other method than pragmas. Default:
# # true.
# add_language_pragma: true

# Align the right hand side of some elements. This is quite conservative
# and only applies to statements where each element occupies a single
# line.
- simple_align:
cases: true
top_level_patterns: true
records: true

# Import cleanup
- imports:
# There are different ways we can align names and lists.
#
# - global: Align the import names and import list throughout the entire
# file.
#
# - file: Like global, but don't add padding when there are no qualified
# imports in the file.
#
# - group: Only align the imports per group (a group is formed by adjacent
# import lines).
#
# - none: Do not perform any alignment.
#
# Default: global.
align: group

# Folowing options affect only import list alignment.
#
# List align has following options:
#
# - after_alias: Import list is aligned with end of import including
# 'as' and 'hiding' keywords.
#
# > import qualified Data.List as List (concat, foldl, foldr, head,
# > init, last, length)
#
# - with_alias: Import list is aligned with start of alias or hiding.
#
# > import qualified Data.List as List (concat, foldl, foldr, head,
# > init, last, length)
#
# - new_line: Import list starts always on new line.
#
# > import qualified Data.List as List
# > (concat, foldl, foldr, head, init, last, length)
#
# Default: after_alias
list_align: after_alias

# Long list align style takes effect when import is too long. This is
# determined by 'columns' setting.
#
# - inline: This option will put as much specs on same line as possible.
#
# - new_line: Import list will start on new line.
#
# - new_line_multiline: Import list will start on new line when it's
# short enough to fit to single line. Otherwise it'll be multiline.
#
# - multiline: One line per import list entry.
# Type with contructor list acts like single import.
#
# > import qualified Data.Map as M
# > ( empty
# > , singleton
# > , ...
# > , delete
# > )
#
# Default: inline
long_list_align: inline

# Align empty list (importing instances)
#
# Empty list align has following options
#
# - inherit: inherit list_align setting
#
# - right_after: () is right after the module name:
#
# > import Vector.Instances ()
#
# Default: inherit
empty_list_align: inherit

# List padding determines indentation of import list on lines after import.
# This option affects 'long_list_align'.
#
# - <integer>: constant value
#
# - module_name: align under start of module name.
# Useful for 'file' and 'group' align settings.
list_padding: 4

# Separate lists option affects formating of import list for type
# or class. The only difference is single space between type and list
# of constructors, selectors and class functions.
#
# - true: There is single space between Foldable type and list of it's
# functions.
#
# > import Data.Foldable (Foldable (fold, foldl, foldMap))
#
# - false: There is no space between Foldable type and list of it's
# functions.
#
# > import Data.Foldable (Foldable(fold, foldl, foldMap))
#
# Default: true
separate_lists: true

# Language pragmas
- language_pragmas:
# We can generate different styles of language pragma lists.
#
# - vertical: Vertical-spaced language pragmas, one per line.
#
# - compact: A more compact style.
#
# - compact_line: Similar to compact, but wrap each line with
# `{-#LANGUAGE #-}'.
#
# Default: vertical.
style: vertical

# Align affects alignment of closing pragma brackets.
#
# - true: Brackets are aligned in same collumn.
#
# - false: Brackets are not aligned together. There is only one space
# between actual import and closing bracket.
#
# Default: true
align: true

# stylish-haskell can detect redundancy of some language pragmas. If this
# is set to true, it will remove those redundant pragmas. Default: true.
remove_redundant: true

# Replace tabs by spaces. This is disabled by default.
# - tabs:
# # Number of spaces to use for each tab. Default: 8, as specified by the
# # Haskell report.
# spaces: 8

# Remove trailing whitespace
- trailing_whitespace: {}

# A common setting is the number of columns (parts of) code will be wrapped
# to. Different steps take this into account. Default: 80.
columns: 800

# By default, line endings are converted according to the OS. You can override
# preferred format here.
#
# - native: Native newline format. CRLF on Windows, LF on other OSes.
#
# - lf: Convert to LF ("\n").
#
# - crlf: Convert to CRLF ("\r\n").
#
# Default: native.
newline: native

# Sometimes, language extensions are specified in a cabal file or from the
# command line instead of using language pragmas in the file. stylish-haskell
# needs to be aware of these, so it can parse the file correctly.
#
# No language extensions are enabled by default.
# language_extensions:
# - TemplateHaskell
# - QuasiQuotes
69 changes: 69 additions & 0 deletions .vscode/tasks.json
Original file line number Diff line number Diff line change
@@ -0,0 +1,69 @@
{
"version": "2.0.0",
"tasks": [
{
"label": "Build",
"type": "shell",
"command": "bash",
"args": ["-lc", "cabal v2-build --enable-tests && echo 'Done'"],
"group": {
"kind": "build",
"isDefault": true
},
"problemMatcher": {
"owner": "haskell",
"fileLocation": "relative",
"pattern": [
{
"regexp": "^(.+?):(\\d+):(\\d+):\\s+(error|warning|info):.*$",
"file": 1, "line": 2, "column": 3, "severity": 4
},
{
"regexp": "\\s*(.*)$",
"message": 1
}
]
},
"presentation": {
"echo": false,
"reveal": "always",
"focus": false,
"panel": "shared",
"showReuseMessage": false,
"clear": true
}
},
{
"label": "Test",
"type": "shell",
"command": "bash",
"args": ["-lc", "cabal v2-test --enable-tests --write-ghc-environment-files=ghc8.4.4+ --test-show-details=direct && echo 'Done'"],
"group": {
"kind": "test",
"isDefault": true
},
"problemMatcher": {
"owner": "haskell",
"fileLocation": "relative",
"pattern": [
{
"regexp": "^(.+?):(\\d+):(\\d+):.*$",
"file": 1, "line": 2, "column": 3, "severity": 4
},
{
"regexp": "\\s*(\\d\\)\\s)?(.*)$",
"message": 2
}
]
},
"presentation": {
"echo": false,
"reveal": "always",
"focus": false,
"panel": "shared",
"showReuseMessage": false,
"clear": true
}
}
]
}
28 changes: 13 additions & 15 deletions data-r-tree.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -32,15 +32,14 @@ common binary { build-depends: binary
common containers { build-depends: containers >= 0.5 && < 0.7 }
common deepseq { build-depends: deepseq >= 1.4 && < 1.5 }
common ghc-heap-view { build-depends: ghc-heap-view >= 0.5 && < 0.7 }
common hedgehog { build-depends: hedgehog >= 1.0.2 && < 1.1 }
common hspec { build-depends: hspec >= 2.4 && < 2.8 }
common HUnit { build-depends: HUnit >= 1.6 && < 1.7 }
common QuickCheck { build-depends: QuickCheck >= 2.13 && < 2.14 }
common test-framework { build-depends: test-framework >= 0.8 && < 0.9 }
common test-framework-hunit { build-depends: test-framework-hunit >= 0.3 && < 0.4 }
common test-framework-quickcheck2 { build-depends: test-framework-quickcheck2 >= 0.3 && < 0.4 }
common hw-hspec-hedgehog { build-depends: hw-hspec-hedgehog >= 0.1 && < 0.2 }

common config
default-language: Haskell2010
ghc-options: -Wall -fwarn-tabs
ghc-options: -Wall -fwarn-tabs -Wno-orphans

common data-r-tree
build-depends: data-r-tree
Expand All @@ -60,28 +59,27 @@ test-suite properties
, binary
, containers
, data-r-tree
, ghc-heap-view
, hedgehog
, hspec
, HUnit
, QuickCheck
, test-framework
, test-framework-hunit
, test-framework-quickcheck2
, hw-hspec-hedgehog
type: exitcode-stdio-1.0
main-is: RTreeProperties.hs
other-extensions: NoMonomorphismRestriction
ghc-options: -Wall -fwarn-tabs -Wno-orphans
other-modules: Gen
hs-source-dirs: test

test-suite strict
import: base, config
, data-r-tree
, deepseq
, ghc-heap-view
, hedgehog
, hspec
, HUnit
, QuickCheck
, test-framework
, test-framework-hunit
, test-framework-quickcheck2
, hw-hspec-hedgehog
type: exitcode-stdio-1.0
main-is: RTreeStrict.hs
ghc-options: -Wall -fwarn-tabs -Wno-orphans
other-modules: Gen
hs-source-dirs: test
45 changes: 45 additions & 0 deletions test/Gen.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,45 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}

module Gen
( mbb
, rtreeInt
) where

import Control.Applicative ((<$>))
import Data.RTree.Base
import Data.RTree.MBB hiding (mbb)
import Hedgehog
import Prelude hiding (length, lookup, map, null)
import Text.Show.Functions ()

import qualified Hedgehog.Gen as G
import qualified Hedgehog.Range as R

mbb :: MonadGen m => m MBB
mbb = G.shrink more $ do
cx <- G.double (R.linearFrac (-100000.0) 100000.0)
cy <- G.double (R.linearFrac (-100000.0) 100000.0)
h <- G.double (R.linearFrac 0.0 100000.0)
w <- G.double (R.linearFrac 0.0 100000.0)
return $ MBB (cx - w) (cy - h) (cx + w) (cy + h)
where more :: MBB -> [MBB]
more mbb'@(MBB ulx uly brx bry)
| isPointMBB mbb' = []
| otherwise = [MBB (mid ulx brx) (mid uly bry) (mid ulx brx) (mid uly bry)]
mid x y = (y - x) / 2

rtreeInt :: MonadGen m => m (RTree Int)
rtreeInt = G.shrink more $ do
ks <- G.list (R.linear 0 100) mbb
return $ fromList (ks `zip` [1..])
where more :: RTree Int -> [RTree Int]
more Empty = []
more Leaf{} = [Empty]
more t =
[Empty] ++
-- shrink to subterms
getChildren t ++
-- recursively shrink subterms
[createNodeWithChildren newChildred | newChildred <- more <$> getChildren t]
Loading

0 comments on commit 8717d63

Please sign in to comment.