{- |

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 :: 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
--------------------------------------------------------------------------------

{- |

@'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 :: forall n. (ToNat n, Num n) => Bounds n -> Gen n
pos (n
a, n
b) = 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
  where
    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)

{- |

@'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 = 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 = 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 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

{- |

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 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

{- |

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 =
    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)

{- |

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)