module Language.Rust.Data.Position (
Position(..),
prettyPosition,
maxPos,
minPos,
initPos,
incPos,
retPos,
incOffset,
Span(..),
unspan,
prettySpan,
subsetOf,
(#),
Spanned(..),
Located(..),
) where
import GHC.Generics ( Generic )
import Control.DeepSeq ( NFData )
import Data.Data ( Data )
import Data.Typeable ( Typeable )
import Data.List.NonEmpty ( NonEmpty(..) )
import Data.Monoid ( Monoid(..) )
import Data.Semigroup ( Semigroup(..) )
data Position = Position {
absoluteOffset :: !Int,
row :: !Int,
col :: !Int
}
| NoPosition
deriving (Eq, Ord, Data, Typeable, Generic, NFData)
instance Show Position where
showsPrec _ NoPosition = showString "NoPosition"
showsPrec p (Position a r c) = showParen (p >= 11)
( showString "Position"
. showString " " . showsPrec 11 a
. showString " " . showsPrec 11 r
. showString " " . showsPrec 11 c )
prettyPosition :: Position -> String
prettyPosition NoPosition = "???"
prettyPosition (Position _ r c) = show r ++ ":" ++ show c
maxPos :: Position -> Position -> Position
maxPos NoPosition p2 = p2
maxPos p1 NoPosition = p1
maxPos p1@(Position a1 _ _) p2@(Position a2 _ _) = if a1 > a2 then p1 else p2
minPos :: Position -> Position -> Position
minPos NoPosition p2 = p2
minPos p1 NoPosition = p1
minPos p1@(Position a1 _ _) p2@(Position a2 _ _) = if a1 < a2 then p1 else p2
initPos :: Position
initPos = Position 0 1 0
incPos :: Position -> Int -> Position
incPos NoPosition _ = NoPosition
incPos p@Position{ absoluteOffset = a, col = c } offset = p { absoluteOffset = a + offset, col = c + offset }
retPos :: Position -> Position
retPos NoPosition = NoPosition
retPos (Position a r _) = Position { absoluteOffset = a + 1, row = r + 1, col = 1 }
incOffset :: Position -> Int -> Position
incOffset NoPosition _ = NoPosition
incOffset p@Position{ absoluteOffset = a } offset = p { absoluteOffset = a + offset }
data Span = Span { lo, hi :: !Position }
deriving (Eq, Ord, Data, Typeable, Generic, NFData)
instance Show Span where
showsPrec p (Span l h) = showParen (p >= 11)
( showString "Span"
. showString " " . showsPrec 11 l
. showString " " . showsPrec 11 h )
subsetOf :: Span -> Span -> Bool
Span l1 h1 `subsetOf` Span l2 h2 = minPos l1 l2 == l1 && maxPos h1 h2 == h2
(#) :: (Located a, Located b) => a -> b -> Span
left # right = spanOf left <> spanOf right
instance Semigroup Span where
Span l1 h1 <> Span l2 h2 = Span (l1 `minPos` l2) (h1 `maxPos` h2)
instance Monoid Span where
mempty = Span NoPosition NoPosition
mappend = (<>)
prettySpan :: Span -> String
prettySpan (Span lo' hi') = show lo' ++ " - " ++ show hi'
data Spanned a = Spanned a !Span
deriving (Eq, Ord, Data, Typeable, Generic, NFData)
unspan :: Spanned a -> a
unspan (Spanned x _) = x
instance Functor Spanned where
fmap f (Spanned x s) = Spanned (f x) s
instance Applicative Spanned where
pure x = Spanned x mempty
Spanned f s1 <*> Spanned x s2 = Spanned (f x) (s1 <> s2)
instance Monad Spanned where
return = pure
Spanned x s1 >>= f = let Spanned y s2 = f x in Spanned y (s1 <> s2)
instance Show a => Show (Spanned a) where
show = show . unspan
class Located a where
spanOf :: a -> Span
instance Located Span where
spanOf = id
instance Located (Spanned a) where
spanOf (Spanned _ s) = s
instance Located a => Located (Maybe a) where
spanOf = foldMap spanOf
instance Located a => Located [a] where
spanOf = foldMap spanOf
instance Located a => Located (NonEmpty a) where
spanOf = foldMap spanOf