{-|
Module      : Prosidy.Source
Description : Utilities for tracking source locaitons.
Copyright   : ©2020 James Alexander Feldman-Crough
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE Safe #-}
module Prosidy.Source
    ( Source(..)
    , Location
    , SparseLocation(..)
    , LineMap
    , Offset(..)
    , Line(..)
    , Column(..)
    , locationSource
    , locationColumn
    , locationLine
    , locationOffset
    , makeSource
    , getSourceLine
    , getLocation
    , enrichLocation
    , stripLocation
    , lineOffsets
    , lineToOffset
    , offsetToLine
    )
where

import           Data.Text                      ( Text )
import           Control.Monad                  ( guard )

import qualified Data.Text                     as T
import qualified Data.Text.Prettyprint.Doc     as PP

import           Prosidy.Internal.Classes
import           Prosidy.Source.LineMap
import           Prosidy.Source.Units

-- | Information about Prosidy source file.
--
-- The 'Show' instance for ths class does not include the 'LineMap' or 'Text'
-- fields, as those are rather noisy.
data Source = Source
  { Source -> String
sourceName    :: String
    -- ^ The reported file-name of the 'Source'.
    --
    -- When read from file handles, a non-filepath description such as
    -- @"\<stdin\>"@ is typically chosen.
    -- This field doesn't have semantic meaning, and should only be used to
    -- enrich the output displayed to users.
  , Source -> Text
sourceText    :: Text
    -- ^ The full source, as 'Text'.
  , Source -> LineMap
sourceLineMap :: LineMap
    -- ^ A mapping of the start position of each line in the 'Source'.
  }
  deriving stock (Source -> Source -> Bool
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Eq, (forall x. Source -> Rep Source x)
-> (forall x. Rep Source x -> Source) -> Generic Source
forall x. Rep Source x -> Source
forall x. Source -> Rep Source x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Source x -> Source
$cfrom :: forall x. Source -> Rep Source x
Generic)
  deriving anyclass (Int -> Source -> Int
Source -> Int
(Int -> Source -> Int) -> (Source -> Int) -> Hashable Source
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Source -> Int
$chash :: Source -> Int
hashWithSalt :: Int -> Source -> Int
$chashWithSalt :: Int -> Source -> Int
Hashable, Source -> ()
(Source -> ()) -> NFData Source
forall a. (a -> ()) -> NFData a
rnf :: Source -> ()
$crnf :: Source -> ()
NFData, Get Source
[Source] -> Put
Source -> Put
(Source -> Put) -> Get Source -> ([Source] -> Put) -> Binary Source
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Source] -> Put
$cputList :: [Source] -> Put
get :: Get Source
$cget :: Get Source
put :: Source -> Put
$cput :: Source -> Put
Binary)

instance Show Source where
    show :: Source -> String
show (Source fp :: String
fp _ _) = "Source " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
fp

instance Pretty Source where
    pretty :: Source -> Doc ann
pretty = String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> (Source -> String) -> Source -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Source -> String
sourceName

-- | Create a 'Source' from a descriptive name and a body. The source name is
-- typically a 'FilePath', but this is not guarenteed. For instance, when read 
-- from standard-input, Prosidy chooses to name the source @\<stdin\>@.
makeSource :: String -> Text -> Source
makeSource :: String -> Text -> Source
makeSource name :: String
name body :: 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 (1, '\0', []) (Text -> (Word, Char, [Offset])) -> Text -> (Word, Char, [Offset])
forall a b. (a -> b) -> a -> b
$ Text
body of
        (_, _, acc :: [Offset]
acc) -> [Offset] -> LineMap
forall (f :: * -> *). Foldable f => f Offset -> LineMap
fromOffsets [Offset]
acc
    lineMapFold :: (Word, Char, [Offset]) -> Char -> (Word, Char, [Offset])
lineMapFold (ix :: Word
ix, prev :: Char
prev, acc :: [Offset]
acc) ch :: Char
ch
        | Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' Bool -> Bool -> Bool
&& Char
prev Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\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 1 [Offset]
acc)
        | Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\n' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '\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
offset src :: 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
line source :: 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

-- | A location in a 'Source'. The line and column numbers of this type are not
-- attached to this type; convert to a 'Location' to access those values.
data SparseLocation = SparseLocation
    { SparseLocation -> Source
sparseLocationSource :: Source
      -- ^ The 'Source' this location references.
    , SparseLocation -> Offset
sparseLocationOffset :: Offset
      -- ^ The position in the 'Source', counted by Unicode codepoints.
    }
  deriving stock (Int -> SparseLocation -> ShowS
[SparseLocation] -> ShowS
SparseLocation -> String
(Int -> SparseLocation -> ShowS)
-> (SparseLocation -> String)
-> ([SparseLocation] -> ShowS)
-> Show SparseLocation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SparseLocation] -> ShowS
$cshowList :: [SparseLocation] -> ShowS
show :: SparseLocation -> String
$cshow :: SparseLocation -> String
showsPrec :: Int -> SparseLocation -> ShowS
$cshowsPrec :: Int -> SparseLocation -> ShowS
Show, (forall x. SparseLocation -> Rep SparseLocation x)
-> (forall x. Rep SparseLocation x -> SparseLocation)
-> Generic SparseLocation
forall x. Rep SparseLocation x -> SparseLocation
forall x. SparseLocation -> Rep SparseLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SparseLocation x -> SparseLocation
$cfrom :: forall x. SparseLocation -> Rep SparseLocation x
Generic, SparseLocation -> SparseLocation -> Bool
(SparseLocation -> SparseLocation -> Bool)
-> (SparseLocation -> SparseLocation -> Bool) -> Eq SparseLocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SparseLocation -> SparseLocation -> Bool
$c/= :: SparseLocation -> SparseLocation -> Bool
== :: SparseLocation -> SparseLocation -> Bool
$c== :: SparseLocation -> SparseLocation -> Bool
Eq)
  deriving anyclass (SparseLocation -> ()
(SparseLocation -> ()) -> NFData SparseLocation
forall a. (a -> ()) -> NFData a
rnf :: SparseLocation -> ()
$crnf :: SparseLocation -> ()
NFData, Get SparseLocation
[SparseLocation] -> Put
SparseLocation -> Put
(SparseLocation -> Put)
-> Get SparseLocation
-> ([SparseLocation] -> Put)
-> Binary SparseLocation
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [SparseLocation] -> Put
$cputList :: [SparseLocation] -> Put
get :: Get SparseLocation
$cget :: Get SparseLocation
put :: SparseLocation -> Put
$cput :: SparseLocation -> Put
Binary, Int -> SparseLocation -> Int
SparseLocation -> Int
(Int -> SparseLocation -> Int)
-> (SparseLocation -> Int) -> Hashable SparseLocation
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SparseLocation -> Int
$chash :: SparseLocation -> Int
hashWithSalt :: Int -> SparseLocation -> Int
$chashWithSalt :: Int -> SparseLocation -> Int
Hashable)

-- | A location in a 'Source', with the line and column number computed lazily.
data Location = Location
    { Location -> Source
locationSource :: Source
      -- ^ The 'Source' this location references.
    , Location -> Offset
locationOffset :: Offset
      -- ^ The position in the 'Source', counted by Unicode codepoints.
    , Location -> Line
locationLine   :: ~Line
      -- ^ The line number in the 'Source'.
    , Location -> Column
locationColumn :: ~Column
      -- ^ The column number in the 'Source'.
    }
  deriving stock (Int -> Location -> ShowS
[Location] -> ShowS
Location -> String
(Int -> Location -> ShowS)
-> (Location -> String) -> ([Location] -> ShowS) -> Show Location
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Location] -> ShowS
$cshowList :: [Location] -> ShowS
show :: Location -> String
$cshow :: Location -> String
showsPrec :: Int -> Location -> ShowS
$cshowsPrec :: Int -> Location -> ShowS
Show, (forall x. Location -> Rep Location x)
-> (forall x. Rep Location x -> Location) -> Generic Location
forall x. Rep Location x -> Location
forall x. Location -> Rep Location x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Location x -> Location
$cfrom :: forall x. Location -> Rep Location x
Generic, Location -> Location -> Bool
(Location -> Location -> Bool)
-> (Location -> Location -> Bool) -> Eq Location
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Location -> Location -> Bool
$c/= :: Location -> Location -> Bool
== :: Location -> Location -> Bool
$c== :: Location -> Location -> Bool
Eq)
  deriving anyclass (Location -> ()
(Location -> ()) -> NFData Location
forall a. (a -> ()) -> NFData a
rnf :: Location -> ()
$crnf :: Location -> ()
NFData, Get Location
[Location] -> Put
Location -> Put
(Location -> Put)
-> Get Location -> ([Location] -> Put) -> Binary Location
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Location] -> Put
$cputList :: [Location] -> Put
get :: Get Location
$cget :: Get Location
put :: Location -> Put
$cput :: Location -> Put
Binary, Int -> Location -> Int
Location -> Int
(Int -> Location -> Int) -> (Location -> Int) -> Hashable Location
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Location -> Int
$chash :: Location -> Int
hashWithSalt :: Int -> Location -> Int
$chashWithSalt :: Int -> Location -> Int
Hashable)

instance Pretty Location where
    pretty :: Location -> Doc ann
pretty loc :: Location
loc = Source -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Location -> Source
locationSource Location
loc) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> "@" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
PP.<+> [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
        [Line -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Location -> Line
locationLine Location
loc), "×", Column -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Location -> Column
locationColumn Location
loc)]

-- | Add lazily computed line and column number information to a 
-- 'SparseLocation'.
enrichLocation :: SparseLocation -> Location
enrichLocation :: SparseLocation -> Location
enrichLocation sl :: SparseLocation
sl = $WLocation :: Source -> Offset -> Line -> Column -> Location
Location { locationSource :: Source
locationSource = Source
source
                             , locationOffset :: Offset
locationOffset = Offset
offset
                             , locationLine :: Line
locationLine   = Line
line
                             , locationColumn :: Column
locationColumn = Column
column
                             }
  where
    source :: Source
source                     = SparseLocation -> Source
sparseLocationSource SparseLocation
sl
    lineMap :: LineMap
lineMap                    = Source -> LineMap
sourceLineMap Source
source
    offset :: Offset
offset@(~(Offset offsetN :: Word
offsetN)) = SparseLocation -> Offset
sparseLocationOffset SparseLocation
sl
    line :: Line
line                       = Offset -> LineMap -> Line
offsetToLine Offset
offset LineMap
lineMap
    column :: Column
column                     = case Line -> LineMap -> Maybe Offset
lineToOffset Line
line LineMap
lineMap of
        Just (Offset n :: Word
n) -> Word -> Column
Column (Word
offsetN Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
n)
        Nothing         -> Word -> Column
Column 0

-- | Remove line and column number information from a 'Location'.
stripLocation :: Location -> SparseLocation
stripLocation :: Location -> SparseLocation
stripLocation l :: Location
l = $WSparseLocation :: Source -> Offset -> SparseLocation
SparseLocation { sparseLocationSource :: Source
sparseLocationSource = Location -> Source
locationSource Location
l
                                 , sparseLocationOffset :: Offset
sparseLocationOffset = Location -> Offset
locationOffset Location
l
                                 }