{-# 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 :: Line
defMaxLine = Line
99

-- | The default maximum column number: 99.
defMaxColumn :: Column
defMaxColumn :: Column
defMaxColumn = Column
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 :: (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
--------------------------------------------------------------------------------

{- |

@'pos' a b@ generates a number on the linear range /a/ to /b/.

-}
pos :: (ToNat n, Num n)
  => Bounds n -- ^ Minimum and maximum value to generate
  -> 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' a b@ generates a line number on the linear range /a/ to /b/.

-}
line
  :: Bounds Line -- ^ Minimum and maximum line number
  -> Gen Line
line :: Bounds Line -> Gen Line
line = Bounds Line -> Gen Line
forall n. (ToNat n, Num n) => Bounds n -> Gen n
pos

{- |

Generates a line number within the default bounds @(1, 'defMaxLine')@.

-}
line' :: Gen Line
line' :: Gen Line
line' =
  Bounds Line -> Gen Line
line (Line
1, Line
defMaxLine)

{- |

@'column' a b@ generates a column number on the linear range /a/ to /b/.

-}
column
  :: Bounds Column -- ^ Minimum and maximum column number
  -> Gen Column
column :: Bounds Column -> Gen Column
column = Bounds Column -> Gen Column
forall n. (ToNat n, Num n) => Bounds n -> Gen n
pos

{- |

Generates a column number within the default bounds @(1, 'defMaxColumn')@.

-}
column' :: Gen Column
column' :: Gen Column
column' =
  Bounds Column -> Gen Column
column (Column
1, Column
defMaxColumn)


--------------------------------------------------------------------------------
--  Loc
--------------------------------------------------------------------------------

{- |

@'loc' lineBounds columnBounds@ generates a 'Loc' with the line number
bounded by @lineBounds@ and column number bounded by @columnBounds@.

-}
loc
  :: Bounds Line   -- ^ Minimum and maximum line number
  -> Bounds Column -- ^ Minimum and maximum column number
  -> 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

{- |

Generates a 'Loc' within the default line and column bounds.

-}
loc' :: Gen Loc
loc' :: Gen Loc
loc' =
  Bounds Line -> Bounds Column -> Gen Loc
loc (Line
1, Line
defMaxLine) (Column
1, Column
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
  :: Bounds Line   -- ^ Minimum and maximum line number
  -> Bounds Column -- ^ Minimum and maximum column number
  -> 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

{- |

Generates a 'Span' with start and end positions within the default line and
column bounds.

-}
span' :: Gen Span
span' :: Gen Span
span' =
  Bounds Line -> Bounds Column -> Gen Span
span (Line
1, Line
defMaxLine) (Column
1, Column
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
  :: Bounds Line   -- ^ Minimum and maximum line number
  -> Bounds Column -- ^ Minimum and maximum column number
  -> 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)

{- |

Generates an 'Area' consisting of 'Span's with start and end positions within
the default line and column bounds.

-}
area' :: Gen Area
area' :: Gen Area
area' =
  Bounds Line -> Bounds Column -> Gen Area
area (Line
1, Line
defMaxLine) (Column
1, Column
defMaxColumn)