{- |
Copyright: © 2019 James Alexander Feldman-Crough
License: MPL-2.0
-}
module ProSource.SourceOps (makeSource, getLocation, getSourceLine) where

import qualified Data.Text as T

import ProSource.Line
import ProSource.LineMap
import ProSource.Location
import ProSource.LocationOps
import ProSource.Offset
import ProSource.Source
import ProSource.SparseLocation

-- | Create a 'Source' from a descriptive name and a body. The source name is typically a 'FilePath', but this is not guaranteed. For instance, when read from standard-input, a common choice is to name the source @\<stdin\>@.
makeSource :: String -> LText -> Source
makeSource :: String -> LText -> Source
makeSource String
name (LText -> Text
toStrictText -> Text
body) = String -> Text -> LineMap -> Source
Source String
name Text
body LineMap
lineMap
  where
    lineMap :: LineMap
lineMap = case ((Word, Char, [Offset]) -> Char -> (Word, Char, [Offset]))
-> (Word, Char, [Offset]) -> Text -> (Word, Char, [Offset])
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' (Word, Char, [Offset]) -> Char -> (Word, Char, [Offset])
lineMapFold (Word
1, Char
'\0', []) (Text -> (Word, Char, [Offset])) -> Text -> (Word, Char, [Offset])
forall a b. (a -> b) -> a -> b
$ Text
body of
        (Word
_, Char
_, [Offset]
acc) -> [Offset] -> LineMap
forall (f :: * -> *). Foldable f => f Offset -> LineMap
fromOffsets [Offset]
acc
    lineMapFold :: (Word, Char, [Offset]) -> Char -> (Word, Char, [Offset])
lineMapFold (Word
ix, Char
prev, [Offset]
acc) Char
ch
        | Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
&& Char
prev Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' = (Word -> Word
forall a. Enum a => a -> a
succ Word
ix, Char
ch, Word -> Offset
Offset Word
ix Offset -> [Offset] -> [Offset]
forall a. a -> [a] -> [a]
: Int -> [Offset] -> [Offset]
forall a. Int -> [a] -> [a]
drop Int
1 [Offset]
acc)
        | Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r'   = (Word -> Word
forall a. Enum a => a -> a
succ Word
ix, Char
ch, Word -> Offset
Offset Word
ix Offset -> [Offset] -> [Offset]
forall a. a -> [a] -> [a]
: [Offset]
acc)
        | Bool
otherwise                  = (Word -> Word
forall a. Enum a => a -> a
succ Word
ix, Char
ch, [Offset]
acc)

-- | Convert an 'Offset' into a 'Location'.
getLocation :: Offset -> Source -> Maybe Location
getLocation :: Offset -> Source -> Maybe Location
getLocation Offset
offset Source
src = do
    Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Text -> Int
T.length (Source -> Text
sourceText Source
src) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Offset -> Int
forall a. Enum a => a -> Int
fromEnum Offset
offset
    Location -> Maybe Location
forall a. a -> Maybe a
Just (Location -> Maybe Location)
-> (SparseLocation -> Location) -> SparseLocation -> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SparseLocation -> Location
enrichLocation (SparseLocation -> Maybe Location)
-> SparseLocation -> Maybe Location
forall a b. (a -> b) -> a -> b
$ Source -> Offset -> SparseLocation
SparseLocation Source
src Offset
offset

-- | Fetch a single line from a source.
getSourceLine :: Line -> Source -> Maybe Text
getSourceLine :: Line -> Source -> Maybe Text
getSourceLine Line
line Source
source = do
    Int
start <- Offset -> Int
forall a. Enum a => a -> Int
fromEnum (Offset -> Int) -> Maybe Offset -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> LineMap -> Maybe Offset
lineToOffset Line
line LineMap
lineMap
    let end :: Maybe Int
end = Offset -> Int
forall a. Enum a => a -> Int
fromEnum (Offset -> Int) -> Maybe Offset -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Line -> LineMap -> Maybe Offset
lineToOffset (Line -> Line
forall a. Enum a => a -> a
succ Line
line) LineMap
lineMap
    Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text)
-> (Int -> Text -> Text) -> Maybe Int -> Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> Text
forall a. a -> a
id (Int -> Text -> Text
T.take (Int -> Text -> Text) -> (Int -> Int) -> Int -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip (-) Int
start)) Maybe Int
end (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
T.drop Int
start (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Source -> Text
sourceText
        Source
source
    where lineMap :: LineMap
lineMap = Source -> LineMap
sourceLineMap Source
source