module Curry.Base.Position
(
HasPosition (..), Position (..), (@>)
, showPosition, ppPosition, ppLine, showLine
, first, next, incr, tab, tabWidth, nl, incPosition
, SrcRef (..), SrcRefOf (..), srcRef, noRef, mk, mk', incSrcRef
) where
import Data.Generics (Data, Typeable)
import System.FilePath
import Curry.Base.Pretty
class HasPosition a where
getPosition :: a -> Position
getPosition _ = NoPos
setPosition :: Position -> a -> a
setPosition _ = id
(@>) :: (HasPosition a, HasPosition b) => a -> b -> a
x @> y = setPosition (getPosition y) x
data Position
= Position
{ file :: FilePath
, line :: Int
, column :: Int
, astRef :: SrcRef
}
| AST
{ astRef :: SrcRef
}
| NoPos
deriving (Eq, Ord, Read, Show, Data, Typeable)
instance HasPosition Position where
getPosition = id
setPosition = const
instance SrcRefOf Position where
srcRefOf NoPos = noRef
srcRefOf x = astRef x
instance Pretty Position where
pPrint = ppPosition
showPosition :: Position -> String
showPosition = show . ppPosition
ppPosition :: Position -> Doc
ppPosition p@(Position f _ _ _)
| null f = lineCol
| otherwise = text (normalise f) <> comma <+> lineCol
where lineCol = ppLine p
ppPosition _ = empty
ppLine :: Position -> Doc
ppLine (Position _ l c _) = text "line" <+> text (show l)
<> if c == 0 then empty else text ('.' : show c)
ppLine _ = empty
showLine :: Position -> String
showLine = show . ppLine
first :: FilePath -> Position
first fn = Position fn 1 1 noRef
next :: Position -> Position
next = flip incr 1
incr :: Position -> Int -> Position
incr p@Position { column = c } n = p { column = c + n }
incr p _ = p
tabWidth :: Int
tabWidth = 8
tab :: Position -> Position
tab p@Position { column = c }
= p { column = c + tabWidth (c 1) `mod` tabWidth }
tab p = p
nl :: Position -> Position
nl p@Position { line = l } = p { line = l + 1, column = 1 }
nl p = p
incPosition :: Position -> Int -> Position
incPosition NoPos _ = NoPos
incPosition p j = p { astRef = incSrcRef (astRef p) j }
newtype SrcRef = SrcRef [Int] deriving (Data, Typeable)
instance Eq SrcRef
where _ == _ = True
instance Ord SrcRef
where compare _ _ = EQ
instance Read SrcRef where
readsPrec _ s = [(noRef, s)]
instance Show SrcRef where
show _ = ""
instance Pretty SrcRef where
pPrint _ = empty
pPrintList _ = empty
class SrcRefOf a where
srcRefsOf :: a -> [SrcRef]
srcRefsOf = (: []) . srcRefOf
srcRefOf :: a -> SrcRef
srcRefOf = head . srcRefsOf
srcRef :: Int -> SrcRef
srcRef i = SrcRef [i]
noRef :: SrcRef
noRef = SrcRef []
mk :: (SrcRef -> a) -> a
mk = ($ noRef)
mk' :: ([SrcRef] -> a) -> a
mk' = ($ [])
incSrcRef :: SrcRef -> Int -> SrcRef
incSrcRef (SrcRef [i]) j = SrcRef [i + j]
incSrcRef (SrcRef is ) _ = error $
"Curry.Base.Position.incSrcRef: SrcRef " ++ show is