Location.hs

{-# LANGUAGE DeriveFunctor #-}

module Zwirn.Language.Location where

{-
    Location.hs - data types and functions for manipulating source locations
    Copyright (C) 2023, Martin Gius

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

import Data.List (find)
import Data.Text (Text)

data RealSrcLoc
  = RealSrcLoc
  { rSrcFile :: !Text,
    rStartLine :: !Int,
    rStartChar :: !Int,
    rEndLine :: !Int,
    rEndChar :: !Int
  }
  deriving (Eq, Show)

data SrcLoc
  = SrcLoc !RealSrcLoc
  | NoLoc
  deriving (Eq, Show)

data Located a
  = Located {lLoc :: !SrcLoc, lValue :: a}
  deriving (Eq, Show, Functor)

data Position = Position Int Int
  deriving (Eq, Show)

instance Semigroup SrcLoc where
  (<>) (SrcLoc (RealSrcLoc p1 lst cst _ _)) (SrcLoc (RealSrcLoc p2 _ _ len cen)) =
    if p1 == p2
      then SrcLoc (RealSrcLoc p1 lst cst len cen)
      else NoLoc
  (<>) NoLoc r = r
  (<>) r NoLoc = r

instance Monoid SrcLoc where
  mempty = NoLoc

noLoc :: a -> Located a
noLoc = Located NoLoc

withLoc :: RealSrcLoc -> a -> Located a
withLoc rn = Located (SrcLoc rn)

mapLoc :: (SrcLoc -> SrcLoc) -> Located a -> Located a
mapLoc f (Located s x) = Located (f s) x

mergeLocs :: [SrcLoc] -> SrcLoc
mergeLocs [] = NoLoc
mergeLocs [x] = x
mergeLocs (x : ys) = x <> last ys

mergeManyWith :: ([Located a] -> b) -> [Located a] -> Located b
mergeManyWith f xs = Located (mergeLocs ls) b
  where
    b = f xs
    ls = map lLoc xs

mergeTwoWith :: (Located a -> Located a -> b) -> Located a -> Located a -> Located b
mergeTwoWith f a b = Located (lLoc a <> lLoc b) (f a b)

mergeThreeWith :: (Located a -> Located a -> Located a -> b) -> Located a -> Located a -> Located a -> Located b
mergeThreeWith f a b c = Located (lLoc a <> lLoc c) (f a b c)

(<->) :: Located a -> Located b -> SrcLoc
(<->) a b = lLoc a <> lLoc b

isContained :: Position -> Located a -> Bool
isContained (Position _ _) (Located NoLoc _) = False
isContained (Position lp cp) (Located (SrcLoc (RealSrcLoc _ lst cst len cen)) _) = lst <= lp && lp <= len && cst <= cp && cp <= cen

findWithPos :: Position -> [Located a] -> Maybe (Located a)
findWithPos p = find (isContained p)