loc-0.2.0.0: test/Gen.hs

module Gen where

import Data.List qualified as List
import Data.Loc qualified as Loc
import Data.Loc.Internal.Prelude
import Data.Loc.Types
import Data.Set qualified as Set
import Hedgehog (Gen)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
import Prelude (Num (..))

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

-- | @'line' a b@ generates a line number on the linear range /a/ to /b/
line ::
  -- | Minimum and maximum line number
  Bounds Line ->
  Gen Line
line (a, b) = Gen.integral (Range.linear a b)

-- | Generates a line number within the default bounds @(1, 'defMaxLine')@
line' :: Gen Line
line' = line (1, defMaxLine)

-- | @'column' a b@ generates a column number on the linear range /a/ to /b/
column ::
  -- | Minimum and maximum column number
  Bounds Column ->
  Gen Column
column (a, b) = Gen.integral (Range.linear a b)

-- | Generates a column number within the default bounds @(1, 'defMaxColumn')@
column' :: Gen 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 ::
  -- | Minimum and maximum line number
  Bounds Line ->
  -- | Minimum and maximum column number
  Bounds Column ->
  Gen Loc
loc lineBounds columnBounds =
  Loc.loc <$> line lineBounds <*> column columnBounds

-- | Generates a 'Loc' within the default line and column bounds
loc' :: Gen 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 ::
  -- | Minimum and maximum line number
  Bounds Line ->
  -- | Minimum and maximum column number
  Bounds Column ->
  Gen Span
span lineBounds columnBounds@(minColumn, maxColumn) =
  let lines :: Gen (Line, Line)
      lines =
        line lineBounds >>= \a ->
          line lineBounds <&> \b ->
            (min a b, max a b)

      columnsDifferentLine :: Gen (Column, Column)
      columnsDifferentLine =
        column columnBounds >>= \a ->
          column columnBounds <&> \b ->
            (a, b)

      columnsSameLine :: Gen (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' :: Gen 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 ::
  -- | Minimum and maximum line number
  Bounds Line ->
  -- | Minimum and maximum column number
  Bounds Column ->
  Gen Area
area lineBounds columnBounds =
  fold . snd . mapAccumL f Nothing . Set.toAscList . Set.fromList <$> locs
  where
    gridSize :: Int =
      max
        (fromIntegral (boundsSize lineBounds))
        (fromIntegral (boundsSize columnBounds))

    locs :: Gen [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' :: Gen Area
area' = area (1, defMaxLine) (1, defMaxColumn)