loc-test (empty) → 0.1.0.0
raw patch · 3 files changed
+313/−0 lines, 3 filesdep +basedep +containersdep +hedgehog
Dependencies added: base, containers, hedgehog, loc
Files
- Test/Loc/Hedgehog/Gen.hs +267/−0
- license.txt +13/−0
- loc-test.cabal +33/−0
+ Test/Loc/Hedgehog/Gen.hs view
@@ -0,0 +1,267 @@+{-# LANGUAGE ScopedTypeVariables #-}++{- |++Hedgehog generators for types defined in the /loc/ package.++-}+module Test.Loc.Hedgehog.Gen+ (+ -- * Line+ line, line', defMaxLine++ -- * Column+ , column, column', defMaxColumn++ -- * Loc+ , loc, loc'++ -- * Span+ , span, span'++ -- * Area+ , area, area'++ -- * Generator bounds+ , Bounds, boundsSize++ ) where++import Data.Loc (ToNat (..))+import Data.Loc.Internal.Prelude+import Data.Loc.Types++import qualified Data.Loc as Loc++import Hedgehog (Gen)+import Prelude (Num (..))++import qualified Data.List as List+import qualified Data.Set as Set+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+++--------------------------------------------------------------------------------+-- Parameter defaults+--------------------------------------------------------------------------------++-- | The default maximum line: 99.+defMaxLine :: Line+defMaxLine = 99++-- | The default maximum column number: 99.+defMaxColumn :: Column+defMaxColumn = 99+++--------------------------------------------------------------------------------+-- Bounds+--------------------------------------------------------------------------------++-- | Inclusive lower and upper bounds on a range.+type Bounds a = (a, a)++{- |++The size of a range specified by 'Bounds'.++Assumes the upper bound is at least the lower bound.++-}+boundsSize :: Num n => (n, n) -> n+boundsSize (a, b) =+ 1 + b - a+++--------------------------------------------------------------------------------+-- Pos+--------------------------------------------------------------------------------++{- |++@'pos' a b@ generates a number on the linear range /a/ to /b/.++-}+pos :: (Monad m, ToNat n, Num n)+ => Bounds n -- ^ Minimum and maximum value to generate+ -> Gen m n+pos (a, b) =+ let+ range = Range.linear (toNat a) (toNat b)+ in+ fromInteger . toInteger <$> Gen.integral range++{- |++@'line' a b@ generates a line number on the linear range /a/ to /b/.++-}+line :: Monad m+ => Bounds Line -- ^ Minimum and maximum line number+ -> Gen m Line+line = pos++{- |++Generates a line number within the default bounds @(1, 'defMaxLine')@.++-}+line' :: Monad m => Gen m Line+line' =+ line (1, defMaxLine)++{- |++@'column' a b@ generates a column number on the linear range /a/ to /b/.++-}+column :: Monad m+ => Bounds Column -- ^ Minimum and maximum column number+ -> Gen m Column+column = pos++{- |++Generates a column number within the default bounds @(1, 'defMaxColumn')@.++-}+column' :: Monad m => Gen m Column+column' =+ column (1, defMaxColumn)+++--------------------------------------------------------------------------------+-- Loc+--------------------------------------------------------------------------------++{- |++@'loc' lineBounds columnBounds@ generates a 'Loc' with the line number+bounded by @lineBounds@ and column number bounded by @columnBounds@.++-}+loc :: Monad m+ => Bounds Line -- ^ Minimum and maximum line number+ -> Bounds Column -- ^ Minimum and maximum column number+ -> Gen m Loc+loc lineBounds columnBounds =+ Loc.loc <$> line lineBounds+ <*> column columnBounds++{- |++Generates a 'Loc' within the default line and column bounds.++-}+loc' :: Monad m => Gen m Loc+loc' =+ loc (1, defMaxLine) (1, defMaxColumn)+++--------------------------------------------------------------------------------+-- Span+--------------------------------------------------------------------------------++{- |++@'span' lineBounds columnBounds@ generates a 'Span' with start and end+positions whose line numbers are bounded by @lineBounds@ and whose column+numbers are bounded by @columnBounds@.++-}+span :: forall m. Monad m+ => Bounds Line -- ^ Minimum and maximum line number+ -> Bounds Column -- ^ Minimum and maximum column number+ -> Gen m Span+span lineBounds columnBounds@(minColumn, maxColumn) =+ let+ lines :: Gen m (Line, Line)+ lines =+ line lineBounds >>= \a ->+ line lineBounds <&> \b ->+ (min a b, max a b)++ columnsDifferentLine :: Gen m (Column, Column)+ columnsDifferentLine =+ column columnBounds >>= \a ->+ column columnBounds <&> \b ->+ (a, b)++ columnsSameLine :: Gen m (Column, Column)+ columnsSameLine =+ column (minColumn + 1, maxColumn) >>= \a ->+ column columnBounds <&> \b ->+ case compare a b of+ EQ -> (a - 1, b)+ LT -> (a, b)+ GT -> (b, a)++ in+ lines >>= \(startLine, endLine) ->+ (if startLine /= endLine+ then columnsDifferentLine+ else columnsSameLine+ ) <&> \(startColumn, endColumn) ->++ let+ start = Loc.loc startLine startColumn+ end = Loc.loc endLine endColumn++ in+ Loc.spanFromTo start end++{- |++Generates a 'Span' with start and end positions within the default line and+column bounds.++-}+span' :: Monad m => Gen m Span+span' =+ span (1, defMaxLine) (1, defMaxColumn)+++--------------------------------------------------------------------------------+-- Area+--------------------------------------------------------------------------------++{- |++@'area' lineBounds columnBounds@ generates an 'Area' consisting of 'Span's+with start and end positions whose line numbers are bounded by @lineBounds@+and whose column numbers are bounded by @columnBounds@.++-}+area :: forall m. Monad m+ => Bounds Line -- ^ Minimum and maximum line number+ -> Bounds Column -- ^ Minimum and maximum column number+ -> Gen m Area+area lineBounds columnBounds =+ fold . snd . mapAccumL f Nothing . Set.toAscList . Set.fromList <$> locs++ where+ gridSize :: Int = fromIntegral $ toNat (boundsSize lineBounds)+ `max` toNat (boundsSize columnBounds)++ locs :: Gen m [Loc]+ = loc lineBounds columnBounds+ & List.repeat+ & List.take (gridSize `div` 5)+ & sequenceA++ f :: Maybe Loc -> Loc -> (Maybe Loc, Area)+ f prevLocMay newLoc =+ case prevLocMay of+ Just prevLoc -> (Nothing, Loc.areaFromTo prevLoc newLoc)+ Nothing -> (Just newLoc, mempty)++{- |++Generates an 'Area' consisting of 'Span's with start and end positions within+the default line and column bounds.++-}+area' :: Monad m => Gen m Area+area' =+ area (1, defMaxLine) (1, defMaxColumn)
+ license.txt view
@@ -0,0 +1,13 @@+Copyright 2017 Chris Martin++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.
+ loc-test.cabal view
@@ -0,0 +1,33 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name: loc-test+version: 0.1.0.0+synopsis: Test-related utilities related to the /loc/ package.++description: Test-related utilities related to the /loc/ package. Currently contains only Hedgehog generators.+category: Testing+homepage: https://github.com/chris-martin/haskell-libraries+author: Chris Martin <ch.martin@gmail.com>+maintainer: Chris Martin <ch.martin@gmail.com>+license: Apache-2.0+license-file: license.txt+build-type: Simple+cabal-version: >= 1.10++library+ hs-source-dirs:+ ./.+ default-extensions: NoImplicitPrelude+ ghc-options: -Wall+ build-depends:+ base >= 4.9 && < 4.10+ , containers+ , loc+ , hedgehog+ exposed-modules:+ Test.Loc.Hedgehog.Gen+ other-modules:+ Paths_loc_test+ default-language: Haskell2010