module Data.Loc (
Pos(..),
posFile,
posLine,
posCol,
posCoff,
startPos,
linePos,
advancePos,
Loc(..),
locStart,
locEnd,
(<-->),
SrcLoc(..),
srclocOf,
srcspan,
IsLocation(..),
noLoc,
Located(..),
Relocatable(..),
L(..),
unLoc
) where
#ifdef __GLASGOW_HASKELL__
import Data.Data (Data(..))
import Data.Typeable (Typeable(..))
#endif
import Data.List (foldl')
import Data.Monoid (Monoid(..))
data Pos =
Pos !String
!Int
!Int
!Int
#ifdef __GLASGOW_HASKELL__
deriving (Eq, Show, Data, Typeable)
#else
deriving (Eq, Show)
#endif
instance Ord Pos where
compare (Pos f1 l1 c1 _) (Pos f2 l2 c2 _) =
compare (f1, l1, c1) (f2, l2, c2)
posFile :: Pos -> String
posFile (Pos f _ _ _) = f
posLine :: Pos -> Int
posLine (Pos _ l _ _) = l
posCol :: Pos -> Int
posCol (Pos _ _ c _) = c
posCoff :: Pos -> Int
posCoff (Pos _ _ _ coff) = coff
startLine :: Int
startLine = 1
startCol :: Int
startCol = 0
startCoff :: Int
startCoff = 0
startPos :: String -> Pos
startPos f = Pos f startLine startCol startCoff
linePos :: String -> Int -> Pos
linePos f l = Pos f l startCol startCoff
advancePos :: Pos -> Char -> Pos
advancePos (Pos f l _ coff) '\n' = Pos f (l+1) startCol (coff + 1)
advancePos (Pos f l c coff) _ = Pos f l (c + 1) (coff + 1)
data Loc = NoLoc
|
Loc !Pos
!Pos
#ifdef __GLASGOW_HASKELL__
deriving (Eq, Show, Data, Typeable)
#else
deriving (Eq, Show)
#endif
locStart :: Loc -> Loc
locStart NoLoc = NoLoc
locStart (Loc p _) = Loc p p
locEnd :: Loc -> Loc
locEnd NoLoc = NoLoc
locEnd (Loc _ p) = Loc p p
instance Monoid Loc where
mempty = NoLoc
NoLoc `mappend` l = l
l `mappend` NoLoc = l
Loc b1 e1 `mappend` Loc b2 e2 = Loc (min b1 b2) (max e1 e2)
(<-->) :: (Located a, Located b) => a -> b -> Loc
x <--> y = locOf x `mappend` locOf y
infixl 6 <-->
newtype SrcLoc = SrcLoc Loc
deriving (Data, Typeable)
instance Eq SrcLoc where
_ == _ = True
instance Ord SrcLoc where
compare _ _ = EQ
instance Show SrcLoc where
showsPrec _ _ = id
srclocOf :: Located a => a -> SrcLoc
srclocOf = fromLoc . locOf
srcspan :: (Located a, Located b) => a -> b -> SrcLoc
x `srcspan` y = SrcLoc (locOf x `mappend` locOf y)
infixl 6 `srcspan`
class IsLocation a where
fromLoc :: Loc -> a
fromPos :: Pos -> a
fromPos p = fromLoc (Loc p p)
instance IsLocation Loc where
fromLoc = id
instance IsLocation SrcLoc where
fromLoc = SrcLoc
noLoc :: IsLocation a => a
noLoc = fromLoc NoLoc
class Located a where
locOf :: a -> Loc
locOfList :: [a] -> Loc
locOfList xs = mconcat (map locOf xs)
instance Located a => Located [a] where
locOf = locOfList
instance Located a => Located (Maybe a) where
locOf Nothing = NoLoc
locOf (Just x) = locOf x
instance Located Pos where
locOf p = Loc p p
instance Located Loc where
locOf = id
instance Located SrcLoc where
locOf (SrcLoc loc) = loc
class Relocatable a where
reloc :: Loc -> a -> a
data L a = L Loc a
unLoc :: L a -> a
unLoc (L _ a) = a
instance Eq x => Eq (L x) where
(L _ x) == (L _ y) = x == y
instance Ord x => Ord (L x) where
compare (L _ x) (L _ y) = compare x y
instance Show x => Show (L x) where
show (L _ x) = show x
instance Located (L a) where
locOf (L loc _) = loc
instance Relocatable (L a) where
reloc loc (L _ x) = L loc x