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 :: forall n. Num n => (n, n) -> n
boundsSize (n
a, n
b) =
n
1 forall a. Num a => a -> a -> a
+ n
b forall a. Num a => a -> a -> a
- n
a
pos :: (ToNat n, Num n)
=> Bounds n
-> Gen n
pos :: forall n. (ToNat n, Num n) => Bounds n -> Gen n
pos (n
a, n
b) =
let
range :: Range Natural
range = forall a. Integral a => a -> a -> Range a
Range.linear (forall a. ToNat a => a -> Natural
toNat n
a) (forall a. ToNat a => a -> Natural
toNat n
b)
in
forall a. Num a => Integer -> a
fromInteger forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = 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 = 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bounds Line -> Gen Line
line Bounds Line
lineBounds
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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Line
a ->
Bounds Line -> Gen Line
line Bounds Line
lineBounds forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Line
b ->
(forall a. Ord a => a -> a -> a
min Line
a Line
b, 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Column
a ->
Bounds Column -> Gen Column
column Bounds Column
columnBounds 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 forall a. Num a => a -> a -> a
+ Column
1, Column
maxColumn) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Column
a ->
Bounds Column -> Gen Column
column Bounds Column
columnBounds forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Column
b ->
case forall a. Ord a => a -> a -> Ordering
compare Column
a Column
b of
Ordering
EQ -> (Column
a 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Line
startLine, Line
endLine) ->
(if Line
startLine forall a. Eq a => a -> a -> Bool
/= Line
endLine
then Gen (Bounds Column)
columnsDifferentLine
else Gen (Bounds Column)
columnsSameLine
) 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 =
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Maybe Loc -> Loc -> (Maybe Loc, Area)
f forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Loc]
locs
where
Int
gridSize :: Int = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. ToNat a => a -> Natural
toNat (forall n. Num n => (n, n) -> n
boundsSize Bounds Line
lineBounds)
forall a. Ord a => a -> a -> a
`max` forall a. ToNat a => a -> Natural
toNat (forall n. Num n => (n, n) -> n
boundsSize Bounds Column
columnBounds)
Gen [Loc]
locs :: Gen [Loc] =
Bounds Line -> Bounds Column -> Gen Loc
loc Bounds Line
lineBounds Bounds Column
columnBounds
forall a b. a -> (a -> b) -> b
& forall a. a -> [a]
List.repeat
forall a b. a -> (a -> b) -> b
& forall a. Int -> [a] -> [a]
List.take (Int
gridSize forall a. Integral a => a -> a -> a
`div` Int
5)
forall a b. a -> (a -> b) -> b
& 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 -> (forall a. Maybe a
Nothing, Loc -> Loc -> Area
Loc.areaFromTo Loc
prevLoc Loc
newLoc)
Maybe Loc
Nothing -> (forall a. a -> Maybe a
Just Loc
newLoc, 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)