{-# LANGUAGE FlexibleContexts, OverloadedStrings #-}

-- | This module implements types and functions to track and highlight locations
-- in source files.
module Data.Text.Prettyprint.Location (
  -- * Source position
  Pos (..)
  , fromOffset
  -- * Source span
  , Span(..)
  , mergeSpan
  -- * Rendering
  , displayPos
  , renderPos
  , renderPosIO
  , renderSpan
  , renderSpanIO
  ) where

import           Data.Text    (Text)
import qualified Data.Text    as T
import qualified Data.Text.IO as T

-- | A point in a source file as a line number, a column number and character
-- offset from the beginning of the file. The line and column number start at 1,
-- the offset starts at 0.
data Pos = Pos { posFile   :: !FilePath
               , posLine   :: {-# UNPACK #-} !Int
               , posCol    :: {-# UNPACK #-} !Int
               , posOffset :: {-# UNPACK #-} !Int
               }
         deriving(Show)

-- | Two positions are equal if they point in the same file with the same offset.
instance Eq Pos where
  Pos { posFile = fp1
      , posOffset = o1
      } == Pos { posFile = fp2
               , posOffset = o2
               } = fp1 == fp2 && o1 == o2

-- | Constructs a complete 'Pos' from the source file and a character offset.
-- Will throw an error if the file is too short.
--
-- The function passed as first argument is used to retrieve the text of the
-- source file. It can be made, for example, to work with a cache to avoid
-- reading the same source file multiple times.
fromOffset :: Monad m
           => (FilePath -> m Text)
           -> FilePath
           -> Int
           -> m Pos
fromOffset readFile fp offset = do
  file <- readFile fp
  let lineFile = T.lines file
      go ln (line : lines) offset
        | offset <= T.length line =
            Pos { posFile = fp
                , posLine = ln
                , posCol = offset + 1
                , posOffset = offset
                }
        | otherwise = go (ln + 1) lines (offset - T.length line - 1)
      go _ [] _ = error "The file is too short for the offset"
  pure (go 1 lineFile offset)

-- | A piece of source file, starting at 'spanStart' and spanning 'spanLen'
-- characters.
data Span = Span { spanStart :: !Pos
                 , spanLen   :: !Int
                 }
          deriving(Eq, Show)

instance Semigroup Span where
  (<>) = mergeSpan

-- | Merge two 'Span's into one covering both.
--
-- For example, merging:
--
-- > int main () { mldkd; }
-- >     ^^^^
--
-- and:
--
-- > int main () { mkdkd; }
-- >               ^^^^^
--
-- results in:
--
-- > int main () { mkdkd; }
-- >     ^^^^^^^^^^^^^^^
mergeSpan :: Span -> Span -> Span
mergeSpan span1@Span { spanStart = start1
                        , spanLen = len1
                        } span2@Span { spanStart = start2
                                        , spanLen = len2
                                        } =
  if posOffset start1 <= posOffset start2
  then Span { spanStart = start1
            , spanLen = posOffset start2 - posOffset start1 + len2
            }
  else mergeSpan span2 span1

-- | Shows a 'Pos' in a standard format.
--
-- >>> displayPos Pos { posFile = "Foo.hs", posLine = 8, posCol = 3, posOffset = 54 }
-- "Foo.hs:8:3"
displayPos :: Pos -> Text
displayPos Pos { posFile = fp
               , posLine = ln
               , posCol = cn
               } = T.intercalate ":" [ T.pack fp
                                     , T.pack (show ln)
                                     , T.pack (show cn)
                                     ]

-- | Highlights a point in the source code with a caret, like so:
--
-- > int main () { mldkd; }
-- >               ^
--
-- The function passed as first argument is used to retrieve the text of the
-- source file. It can be used, for example, to work with a cache to avoid
-- reading the same source file multiple times.
renderPos :: Monad m
          => (FilePath -> m Text)
          -> Pos
          -> m Text
renderPos readFile pos =
  renderSpan readFile Span { spanStart = pos
                           , spanLen = 1
                           }


-- | Specialised version of 'renderPos' that uses 'T.readFile' to retrieve the
-- source text.
renderPosIO :: Pos -> IO Text
renderPosIO = renderPos T.readFile

-- | Highlights the piece of source code designated by the 'Span'.
--
-- If it spans a single line, it is rendered like so:
--
-- > int main () { mldkd; }
-- >               ^^^^^
--
-- If it spans multiple lines, it is rendered like so:
--
-- > > int main() {
-- > >  int x = 0;
-- > >  int y = 1;
-- > >  foo(x,y);
-- > > }
--
-- It may throw an error if the source file is too short.
--
-- The function passed as first argument is used to retrieve the text of the
-- source file. It can be used, for example, to work with a cache to avoid
-- reading the same source file multiple times.
renderSpan :: Monad m
           => (FilePath -> m Text)
           -> Span
           -> m Text
renderSpan readFile Span { spanStart = Pos { posFile = fp
                                              , posLine = row
                                              , posCol = col
                                              , posOffset = offset
                                              }
                            , spanLen = len
                            } = do
  file <- readFile fp
  let linedFile = T.lines file
      highlightedPart = T.take len (T.drop offset file)
      numberOfLinesToHightlight =
        length $ T.lines highlightedPart

      rendered =
        if numberOfLinesToHightlight == 1
        then let spikes = T.replicate (col - 1) " " <> T.replicate len "^"
                 str = if length linedFile < row - 1
                       then error "The file is too short to render this span"
                       else linedFile !! (row - 1)
             in [str, spikes]
        else let displayedLines =
                   take numberOfLinesToHightlight (drop (row - 1) linedFile)
             in fmap ("> " <>) displayedLines
  pure (T.unlines rendered)

-- | Specialised version of 'renderSpan' using 'T.readFile' to retrieve the
-- source text.
renderSpanIO :: Span -> IO Text
renderSpanIO = renderSpan T.readFile