semantic/src/Source.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
module Source where

import Prologue hiding (uncons)
import Data.Text (unpack, pack)
import Data.String
import qualified Data.Vector as Vector
import Numeric
import Range
import SourceSpan

-- | The source, oid, path, and Maybe SourceKind of a blob in a Git repo.
data SourceBlob = SourceBlob { source :: Source Char, oid :: String, path :: FilePath, blobKind :: Maybe SourceKind }
  deriving (Show, Eq)

-- | The contents of a source file, backed by a vector for efficient slicing.
newtype Source a = Source { getVector :: Vector.Vector a  }
  deriving (Eq, Show, Foldable, Functor, Traversable)

-- | The kind of a blob, along with it's file mode.
data SourceKind = PlainBlob Word32  | ExecutableBlob Word32 | SymlinkBlob Word32
  deriving (Show, Eq)

modeToDigits :: SourceKind -> String
modeToDigits (PlainBlob mode) = showOct mode ""
modeToDigits (ExecutableBlob mode) = showOct mode ""
modeToDigits (SymlinkBlob mode) = showOct mode ""


-- | The default plain blob mode
defaultPlainBlob :: SourceKind
defaultPlainBlob = PlainBlob 0o100644

emptySourceBlob :: FilePath -> SourceBlob
emptySourceBlob filepath = SourceBlob (Source.fromList "")  Source.nullOid filepath Nothing

sourceBlob :: Source Char -> FilePath -> SourceBlob
sourceBlob source filepath = SourceBlob source Source.nullOid filepath (Just defaultPlainBlob)

-- | Map blobs with Nothing blobKind to empty blobs.
idOrEmptySourceBlob :: SourceBlob -> SourceBlob
idOrEmptySourceBlob blob = if isNothing (blobKind blob)
                           then blob { oid = nullOid, blobKind = Nothing }
                           else blob

nullOid :: String
nullOid = "0000000000000000000000000000000000000000"

-- | Return a Source from a list of items.
fromList :: [a] -> Source a
fromList = Source . Vector.fromList

-- | Return a Source of Chars from a Text.
fromText :: Text -> Source Char
fromText = Source . Vector.fromList . unpack

-- | Return a Source that contains a slice of the given Source.
slice :: Range -> Source a -> Source a
slice range = Source . Vector.slice (start range) (rangeLength range) . getVector

-- | Return a String with the contents of the Source.
toString :: Source Char -> String
toString = toList

-- | Return a text with the contents of the Source.
toText :: Source Char -> Text
toText = pack . toList

-- | Return the item at the given  index.
at :: Source a -> Int -> a
at = (Vector.!) . getVector

-- | Remove the first item and return it with the rest of the source.
uncons :: Source a -> Maybe (a, Source a)
uncons (Source vector) = if null vector then Nothing else Just (Vector.head vector, Source $ Vector.tail vector)

-- | Split the source into the longest prefix of elements that do not satisfy the predicate and the rest without copying.
break :: (a -> Bool) -> Source a -> (Source a, Source a)
break predicate (Source vector) = let (start, remainder) = Vector.break predicate vector in (Source start, Source remainder)

-- | Split the contents of the source after newlines.
actualLines :: Source Char -> [Source Char]
actualLines source | null source = [ source ]
actualLines source = case Source.break (== '\n') source of
  (l, lines') -> case uncons lines' of
    Nothing -> [ l ]
    Just (_, lines') -> (l <> fromList "\n") : actualLines lines'

-- | Compute the line ranges within a given range of a string.
actualLineRanges :: Range -> Source Char -> [Range]
actualLineRanges range = drop 1 . scanl toRange (Range (start range) (start range)) . actualLines . slice range
  where toRange previous string = Range (end previous) $ end previous + length string

-- | Compute the character range given a Source and a SourceSpan.
sourceSpanToRange :: Source Char -> SourceSpan -> Range
sourceSpanToRange source SourceSpan{..} = Range start end
  where start = sumLengths leadingRanges + column spanStart
        end = start + sumLengths (take (line spanEnd - line spanStart) remainingRanges) + (column spanEnd - column spanStart)
        (leadingRanges, remainingRanges) = splitAt (line spanStart) (actualLineRanges (totalRange source) source)
        sumLengths = sum . fmap (\ Range{..} -> end - start)

rangeToSourceSpan :: Source Char -> Range -> SourceSpan
rangeToSourceSpan source range@Range{} = SourceSpan startPos endPos
  where startPos = maybe (SourcePos 1 1) (toStartPos 1) (head lineRanges)
        endPos = toEndPos (length lineRanges) (fromMaybe (rangeAt 0) (snd <$> unsnoc lineRanges))
        lineRanges = actualLineRanges range source
        toStartPos line range = SourcePos line (start range)
        toEndPos line range = SourcePos line (end range)


instance Semigroup (Source a) where
  Source a <> Source b = Source (a Vector.++ b)

instance Monoid (Source a) where
  mempty = fromList []
  mappend = (<>)