{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeFamilies #-}

module Descript.Misc.Loc
  ( Loc (..)
  , LocDiff (..)
  , Range (..)
  , singletonRange
  , textRange
  , inText'
  , inText
  , beforeInText
  , afterInText
  , isSingletonRange
  , isInRange
  , subRange
  , textDiff
  , rangeDiff
  , offsetRange
  , addDiff
  , addCols
  , posIdx
  , loc1
  -- * Reexported from 'Text.Megaparsec.Pos'
  , mkPos
  , unPos
  ) where

import Descript.Misc.Ann
import Descript.Misc.Summary
import Text.Megaparsec.Pos
import qualified Data.Monoid as Monoid ((<>))
import Data.Semigroup hiding (diff)
import Core.Data.Group
import Core.Data.List
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Core.Data.Text as Text
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Prelude hiding (lines)

data Loc
  = Loc
  { line :: !Pos
  , column :: !Pos
  } deriving (Eq, Ord, Read, Show)

data LocDiff
  = LocDiff
  { lineDiff :: Int
  , colDiffs :: IntMap Int -- ^ Column diffs are values, matter only on line pos keys.
  } deriving (Eq, Ord, Read, Show)

data Range
  = Range
  { start :: Loc
  , end :: Loc
  } deriving (Eq, Ord, Read, Show)

instance Monoid LocDiff where
  mempty
    = LocDiff
    { lineDiff = 0
    , colDiffs = IntMap.empty
    }

  LocDiff xLineDiff xColDiffs `mappend` LocDiff yLineDiff yColDiffs
    = LocDiff
    { lineDiff = xLineDiff + yLineDiff
    , colDiffs = optColDiffs $ IntMap.unionWith (+) xColDiffs yColDiffs
    }

instance Subtract LocDiff where
  x \\ y = x Monoid.<> invert y

instance Group LocDiff where
  invert (LocDiff lineDiff' colDiffs')
    = LocDiff
    { lineDiff = negate lineDiff'
    , colDiffs
        = optColDiffs
        $ IntMap.fromDistinctAscList
        $ map affectColDiff
        $ IntMap.toDescList
          colDiffs'
    }
    where affectColDiff (targetLine, colDiff)
            = (targetLine + lineDiff', negate colDiff)

instance Semigroup Range where
  Range xStart xEnd <> Range yStart yEnd
    = Range
    { start = min xStart yStart
    , end = max xEnd yEnd
    }

instance AnnSummary Range where
  annSummaryPre range = summary range ++ ": "

instance Summary Range where
  summaryRec sub (Range start' end')
     | start' == end'
     = sub start'
     | line start' == line end'
     = "line "
    ++ sub (line start')
    ++ ", columns "
    ++ sub (column start')
    ++ " to "
    ++ sub (column end')
     | otherwise
     = summary start' ++ " to " ++ summary end'

instance Summary Loc where
  summaryRec sub loc = "line " ++ sub (line loc) ++ ", column " ++ sub (column loc)

-- | A range which starts and ends at the given location.
singletonRange :: Loc -> Range
singletonRange loc
  = Range
  { start = loc
  , end = loc
  }

-- | The range from the start to the end of the text.
textRange :: Text -> Range
textRange text
  = Range
  { start = loc1
  , end = textEndLoc text
  }

-- | The location at the end of the text
textEndLoc :: Text -> Loc
textEndLoc text
  = Loc
  { line = mkPos $ 1 + length lines
  , column = mkPos $ 1 + Text.length lastLine
  }
  where lastLine = last lines
        lines = Text.lines' text

-- | Gets the text at the given range. Assumes the range is in the text.
-- If no range is given, returns an empty text.
inText' :: Maybe Range -> Text -> Text
Nothing `inText'` _ = Text.empty
Just range' `inText'` text = range' `inText` text

-- | Gets the text at the given range. Assumes the range is in the text.
inText :: Range -> Text -> Text
inText range'
  = Text.unlines'
  . overHead (Text.drop $ posIdx $ column $ start range')
  . overLast (Text.take $ posIdx $ column $ end range')
  . drop (posIdx $ line $ start range')
  . take (succ $ posIdx $ line $ end range')
  . Text.lines'

-- | Gets the text before the given location. Assumes the location is in the text.
beforeInText :: Loc -> Text -> Text
beforeInText end'
  = Text.unlines'
  . overLast (Text.take $ posIdx $ column $ end')
  . take (succ $ posIdx $ line $ end')
  . Text.lines'

-- | Gets the text after the given location. Assumes the location is in the text.
afterInText :: Loc -> Text -> Text
afterInText start'
  = Text.unlines'
  . overHead (Text.drop $ posIdx $ column $ start')
  . drop (posIdx $ line $ start')
  . Text.lines'

-- | Does the range cover no text (ends at the same position it starts)?
isSingletonRange :: Range -> Bool
isSingletonRange range = start range == end range

-- | Is the location in the range? Counts locations at the start or end
-- of the range.
isInRange :: Loc -> Range -> Bool
isInRange loc (Range start' end') = start' <= loc && end' >= loc

-- | Removes locations in the second range from the first.
subRange :: Range -> Range -> [Range]
Range xStart xEnd `subRange` Range yStart yEnd
  | xEnd <= yStart || yStart >= yEnd
  = [Range xStart xEnd]
  | xStart < yStart && xEnd > yEnd
  = [Range xStart yStart, Range yEnd xEnd]
  | xStart < yStart && xEnd <= yEnd
  = [Range xStart yStart]
  | xStart >= yStart && xEnd > yEnd
  = [Range yEnd xEnd]
  | xStart >= yStart && xEnd <= yEnd
  = []
  | otherwise
  = error "unexpected \"impossible\" location comparison"

-- | The amount of lines (down cursor movements) and columns
-- (right cursor movements) which cover the text starting at the line.
textDiff :: Pos -> Text -> LocDiff
textDiff line' text
  = LocDiff
  { lineDiff = length lines - 1
  , colDiffs = optColDiffs colDiffs'
  }
  where colDiffs' = IntMap.singleton (unPos line') $ Text.length lastLine
        lastLine = last lines
        lines = Text.lines' text

-- | The amount of lines (down cursor movements) and columns
-- (right cursor movements) which cover the range.
rangeDiff :: Range -> LocDiff
rangeDiff (Range start' end')
  = LocDiff
  { lineDiff = unPos (line end') - unPos (line start')
  , colDiffs = optColDiffs $ IntMap.singleton (unPos $ line start') $ unPos (column end') - unPos (column start')
  }

-- | Adds the given difference to the start and end of the range.
offsetRange :: LocDiff -> Range -> Range
offsetRange diff (Range start' end')
  = Range
  { start = start' `addDiff` diff
  , end = end' `addDiff` diff
  }

-- | Adds the given difference to the location.
addDiff :: Loc -> LocDiff -> Loc
Loc line' column' `addDiff` LocDiff lineDiff' colDiffs'
  = Loc
  { line = mkPos $ unPos line' + lineDiff'
  , column = mkPos $ unPos column' + colDiff
  }
  where colDiff = IntMap.findWithDefault 0 (unPos line') colDiffs'

-- | Adds columns to the location.
addCols :: Loc -> Int -> Loc
Loc line' column' `addCols` len
  = Loc
  { line = line'
  , column = mkPos $ unPos column' + len
  }

-- | Converts 1-based 'Pos' to 0-based index.
posIdx :: Pos -> Int
posIdx = pred . unPos

-- | Removes 0-column differences.
optColDiffs :: IntMap Int -> IntMap Int
optColDiffs = IntMap.filter (/= 0)

-- | Line 1, column 1
loc1 :: Loc
loc1 = Loc{ line = pos1, column = pos1 }