{-# LANGUAGE ScopedTypeVariables #-}
module Test.Loc.Hedgehog.Gen
(
line, line', defMaxLine
, column, column', defMaxColumn
, loc, loc'
, span, span'
, area, area'
, 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
defMaxLine :: Line
defMaxLine :: Line
defMaxLine = Line
99
defMaxColumn :: Column
defMaxColumn :: Column
defMaxColumn = Column
99
type Bounds a = (a, a)
boundsSize :: Num n => (n, n) -> n
boundsSize :: (n, n) -> n
boundsSize (n
a, n
b) =
n
1 n -> n -> n
forall a. Num a => a -> a -> a
+ n
b n -> n -> n
forall a. Num a => a -> a -> a
- n
a
pos :: (ToNat n, Num n)
=> Bounds n
-> Gen n
pos :: Bounds n -> Gen n
pos (n
a, n
b) =
let
range :: Range Natural
range = Natural -> Natural -> Range Natural
forall a. Integral a => a -> a -> Range a
Range.linear (n -> Natural
forall a. ToNat a => a -> Natural
toNat n
a) (n -> Natural
forall a. ToNat a => a -> Natural
toNat n
b)
in
Integer -> n
forall a. Num a => Integer -> a
fromInteger (Integer -> n) -> (Natural -> Integer) -> Natural -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> n) -> GenT Identity Natural -> Gen n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range Natural -> GenT Identity Natural
forall (m :: * -> *) a. (MonadGen m, Integral a) => Range a -> m a
Gen.integral Range Natural
range
line
:: Bounds Line
-> Gen Line
line :: Bounds Line -> Gen Line
line = Bounds Line -> Gen Line
forall n. (ToNat n, Num n) => Bounds n -> Gen n
pos
line' :: Gen Line
line' :: Gen Line
line' =
Bounds Line -> Gen Line
line (Line
1, Line
defMaxLine)
column
:: Bounds Column
-> Gen Column
column :: Bounds Column -> Gen Column
column = Bounds Column -> Gen Column
forall n. (ToNat n, Num n) => Bounds n -> Gen n
pos
column' :: Gen Column
column' :: Gen Column
column' =
Bounds Column -> Gen Column
column (Column
1, Column
defMaxColumn)
loc
:: Bounds Line
-> Bounds Column
-> Gen Loc
loc :: Bounds Line -> Bounds Column -> Gen Loc
loc Bounds Line
lineBounds Bounds Column
columnBounds =
Line -> Column -> Loc
Loc.loc (Line -> Column -> Loc)
-> Gen Line -> GenT Identity (Column -> Loc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bounds Line -> Gen Line
line Bounds Line
lineBounds
GenT Identity (Column -> Loc) -> Gen Column -> Gen Loc
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bounds Column -> Gen Column
column Bounds Column
columnBounds
loc' :: Gen Loc
loc' :: Gen Loc
loc' =
Bounds Line -> Bounds Column -> Gen Loc
loc (Line
1, Line
defMaxLine) (Column
1, Column
defMaxColumn)
span
:: Bounds Line
-> Bounds Column
-> Gen Span
span :: Bounds Line -> Bounds Column -> Gen Span
span Bounds Line
lineBounds columnBounds :: Bounds Column
columnBounds@(Column
minColumn, Column
maxColumn) =
let
lines :: Gen (Line, Line)
lines :: Gen (Bounds Line)
lines =
Bounds Line -> Gen Line
line Bounds Line
lineBounds Gen Line -> (Line -> Gen (Bounds Line)) -> Gen (Bounds Line)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Line
a ->
Bounds Line -> Gen Line
line Bounds Line
lineBounds Gen Line -> (Line -> Bounds Line) -> Gen (Bounds Line)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Line
b ->
(Line -> Line -> Line
forall a. Ord a => a -> a -> a
min Line
a Line
b, Line -> Line -> Line
forall a. Ord a => a -> a -> a
max Line
a Line
b)
columnsDifferentLine :: Gen (Column, Column)
columnsDifferentLine :: Gen (Bounds Column)
columnsDifferentLine =
Bounds Column -> Gen Column
column Bounds Column
columnBounds Gen Column
-> (Column -> Gen (Bounds Column)) -> Gen (Bounds Column)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Column
a ->
Bounds Column -> Gen Column
column Bounds Column
columnBounds Gen Column -> (Column -> Bounds Column) -> Gen (Bounds Column)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Column
b ->
(Column
a, Column
b)
columnsSameLine :: Gen (Column, Column)
columnsSameLine :: Gen (Bounds Column)
columnsSameLine =
Bounds Column -> Gen Column
column (Column
minColumn Column -> Column -> Column
forall a. Num a => a -> a -> a
+ Column
1, Column
maxColumn) Gen Column
-> (Column -> Gen (Bounds Column)) -> Gen (Bounds Column)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Column
a ->
Bounds Column -> Gen Column
column Bounds Column
columnBounds Gen Column -> (Column -> Bounds Column) -> Gen (Bounds Column)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Column
b ->
case Column -> Column -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Column
a Column
b of
Ordering
EQ -> (Column
a Column -> Column -> Column
forall a. Num a => a -> a -> a
- Column
1, Column
b)
Ordering
LT -> (Column
a, Column
b)
Ordering
GT -> (Column
b, Column
a)
in
Gen (Bounds Line)
lines Gen (Bounds Line) -> (Bounds Line -> Gen Span) -> Gen Span
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Line
startLine, Line
endLine) ->
(if Line
startLine Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
/= Line
endLine
then Gen (Bounds Column)
columnsDifferentLine
else Gen (Bounds Column)
columnsSameLine
) Gen (Bounds Column) -> (Bounds Column -> Span) -> Gen Span
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Column
startColumn, Column
endColumn) ->
let
start :: Loc
start = Line -> Column -> Loc
Loc.loc Line
startLine Column
startColumn
end :: Loc
end = Line -> Column -> Loc
Loc.loc Line
endLine Column
endColumn
in
Loc -> Loc -> Span
Loc.spanFromTo Loc
start Loc
end
span' :: Gen Span
span' :: Gen Span
span' =
Bounds Line -> Bounds Column -> Gen Span
span (Line
1, Line
defMaxLine) (Column
1, Column
defMaxColumn)
area
:: Bounds Line
-> Bounds Column
-> Gen Area
area :: Bounds Line -> Bounds Column -> Gen Area
area Bounds Line
lineBounds Bounds Column
columnBounds =
[Area] -> Area
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Area] -> Area) -> ([Loc] -> [Area]) -> [Loc] -> Area
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Loc, [Area]) -> [Area]
forall a b. (a, b) -> b
snd ((Maybe Loc, [Area]) -> [Area])
-> ([Loc] -> (Maybe Loc, [Area])) -> [Loc] -> [Area]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Loc -> Loc -> (Maybe Loc, Area))
-> Maybe Loc -> [Loc] -> (Maybe Loc, [Area])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL Maybe Loc -> Loc -> (Maybe Loc, Area)
f Maybe Loc
forall a. Maybe a
Nothing ([Loc] -> (Maybe Loc, [Area]))
-> ([Loc] -> [Loc]) -> [Loc] -> (Maybe Loc, [Area])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Loc -> [Loc]
forall a. Set a -> [a]
Set.toAscList (Set Loc -> [Loc]) -> ([Loc] -> Set Loc) -> [Loc] -> [Loc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Loc] -> Set Loc
forall a. Ord a => [a] -> Set a
Set.fromList ([Loc] -> Area) -> GenT Identity [Loc] -> Gen Area
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity [Loc]
locs
where
Int
gridSize :: Int = Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Int) -> Natural -> Int
forall a b. (a -> b) -> a -> b
$ Line -> Natural
forall a. ToNat a => a -> Natural
toNat (Bounds Line -> Line
forall n. Num n => (n, n) -> n
boundsSize Bounds Line
lineBounds)
Natural -> Natural -> Natural
forall a. Ord a => a -> a -> a
`max` Column -> Natural
forall a. ToNat a => a -> Natural
toNat (Bounds Column -> Column
forall n. Num n => (n, n) -> n
boundsSize Bounds Column
columnBounds)
GenT Identity [Loc]
locs :: Gen [Loc] =
Bounds Line -> Bounds Column -> Gen Loc
loc Bounds Line
lineBounds Bounds Column
columnBounds
Gen Loc -> (Gen Loc -> [Gen Loc]) -> [Gen Loc]
forall a b. a -> (a -> b) -> b
& Gen Loc -> [Gen Loc]
forall a. a -> [a]
List.repeat
[Gen Loc] -> ([Gen Loc] -> [Gen Loc]) -> [Gen Loc]
forall a b. a -> (a -> b) -> b
& Int -> [Gen Loc] -> [Gen Loc]
forall a. Int -> [a] -> [a]
List.take (Int
gridSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5)
[Gen Loc]
-> ([Gen Loc] -> GenT Identity [Loc]) -> GenT Identity [Loc]
forall a b. a -> (a -> b) -> b
& [Gen Loc] -> GenT Identity [Loc]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA
f :: Maybe Loc -> Loc -> (Maybe Loc, Area)
f :: Maybe Loc -> Loc -> (Maybe Loc, Area)
f Maybe Loc
prevLocMay Loc
newLoc =
case Maybe Loc
prevLocMay of
Just Loc
prevLoc -> (Maybe Loc
forall a. Maybe a
Nothing, Loc -> Loc -> Area
Loc.areaFromTo Loc
prevLoc Loc
newLoc)
Maybe Loc
Nothing -> (Loc -> Maybe Loc
forall a. a -> Maybe a
Just Loc
newLoc, Area
forall a. Monoid a => a
mempty)
area' :: Gen Area
area' :: Gen Area
area' =
Bounds Line -> Bounds Column -> Gen Area
area (Line
1, Line
defMaxLine) (Column
1, Column
defMaxColumn)