{-# LANGUAGE DeriveGeneric #-}
module Language.PureScript.AST.SourcePos where
import Prelude.Compat
import Control.DeepSeq (NFData)
import Data.Aeson ((.=), (.:))
import Data.Text (Text)
import GHC.Generics (Generic)
import Language.PureScript.Comments
import qualified Data.Aeson as A
import qualified Data.Text as T
import System.FilePath (makeRelative)
type SourceAnn = (SourceSpan, [Comment])
data SourcePos = SourcePos
{ sourcePosLine :: Int
, sourcePosColumn :: Int
} deriving (Show, Eq, Ord, Generic)
instance NFData SourcePos
displaySourcePos :: SourcePos -> Text
displaySourcePos sp =
"line " <> T.pack (show (sourcePosLine sp)) <>
", column " <> T.pack (show (sourcePosColumn sp))
displaySourcePosShort :: SourcePos -> Text
displaySourcePosShort sp =
T.pack (show (sourcePosLine sp)) <>
":" <> T.pack (show (sourcePosColumn sp))
instance A.ToJSON SourcePos where
toJSON SourcePos{..} =
A.toJSON [sourcePosLine, sourcePosColumn]
instance A.FromJSON SourcePos where
parseJSON arr = do
[line, col] <- A.parseJSON arr
return $ SourcePos line col
data SourceSpan = SourceSpan
{ spanName :: String
, spanStart :: SourcePos
, spanEnd :: SourcePos
} deriving (Show, Eq, Ord, Generic)
instance NFData SourceSpan
displayStartEndPos :: SourceSpan -> Text
displayStartEndPos sp =
"(" <>
displaySourcePos (spanStart sp) <> " - " <>
displaySourcePos (spanEnd sp) <> ")"
displayStartEndPosShort :: SourceSpan -> Text
displayStartEndPosShort sp =
displaySourcePosShort (spanStart sp) <> " - " <>
displaySourcePosShort (spanEnd sp)
displaySourceSpan :: FilePath -> SourceSpan -> Text
displaySourceSpan relPath sp =
T.pack (makeRelative relPath (spanName sp)) <> ":" <>
displayStartEndPosShort sp <> " " <>
displayStartEndPos sp
instance A.ToJSON SourceSpan where
toJSON SourceSpan{..} =
A.object [ "name" .= spanName
, "start" .= spanStart
, "end" .= spanEnd
]
instance A.FromJSON SourceSpan where
parseJSON = A.withObject "SourceSpan" $ \o ->
SourceSpan <$>
o .: "name" <*>
o .: "start" <*>
o .: "end"
internalModuleSourceSpan :: String -> SourceSpan
internalModuleSourceSpan name = SourceSpan name (SourcePos 0 0) (SourcePos 0 0)
nullSourceSpan :: SourceSpan
nullSourceSpan = internalModuleSourceSpan ""
nullSourceAnn :: SourceAnn
nullSourceAnn = (nullSourceSpan, [])
pattern NullSourceSpan :: SourceSpan
pattern NullSourceSpan = SourceSpan "" (SourcePos 0 0) (SourcePos 0 0)
pattern NullSourceAnn :: SourceAnn
pattern NullSourceAnn = (NullSourceSpan, [])
nonEmptySpan :: SourceAnn -> Maybe SourceSpan
nonEmptySpan (NullSourceSpan, _) = Nothing
nonEmptySpan (ss, _) = Just ss
widenSourceSpan :: SourceSpan -> SourceSpan -> SourceSpan
widenSourceSpan NullSourceSpan b = b
widenSourceSpan a NullSourceSpan = a
widenSourceSpan (SourceSpan n1 s1 e1) (SourceSpan n2 s2 e2) =
SourceSpan n (min s1 s2) (max e1 e2)
where
n | n1 == "" = n2
| otherwise = n1
widenSourceAnn :: SourceAnn -> SourceAnn -> SourceAnn
widenSourceAnn (s1, _) (s2, _) = (widenSourceSpan s1 s2, [])