~jojo/Carth

ref: 749208029494a7c48ce04444a513424f4b998416 Carth/src/SrcPos.hs -rw-r--r-- 1.0 KiB
74920802JoJo update TODO 6 months ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
module SrcPos where

import Text.Megaparsec.Pos

data SrcPos = SrcPos
    { srcName :: FilePath
    , srcLine :: Word
    , srcColumn :: Word
    , inExpansion :: Maybe SrcPos
    }
    deriving (Show, Eq, Ord)


data WithPos a = WithPos SrcPos a

class HasPos a where
    getPos :: a -> SrcPos


instance Show a => Show (WithPos a) where
    showsPrec p (WithPos _ a) = showsPrec p a
instance Eq a => Eq (WithPos a) where
    (WithPos _ a) == (WithPos _ b) = a == b
instance Ord a => Ord (WithPos a) where
    compare (WithPos _ a) (WithPos _ b) = compare a b

instance HasPos (WithPos a) where
    getPos (WithPos p _) = p

mapPosd :: (a -> b) -> WithPos a -> WithPos b
mapPosd f (WithPos p a) = WithPos p (f a)

mapPosdM :: Monad m => (a -> m b) -> WithPos a -> m (WithPos b)
mapPosdM f (WithPos p a) = fmap (WithPos p) (f a)

unpos :: WithPos a -> a
unpos (WithPos _ a) = a

prettySrcPos :: SrcPos -> String
prettySrcPos (SrcPos f l c _) =
    sourcePosPretty (SourcePos f (mkPos (fromIntegral l)) (mkPos (fromIntegral c)))