{-# LANGUAGE CPP #-}
module Curry.Base.Position
(
HasPosition (..), Position (..), (@>)
, showPosition, ppPosition, ppLine, showLine
, first, next, incr, tab, tabWidth, nl
) where
#if __GLASGOW_HASKELL__ >= 804
import Prelude hiding ((<>))
#endif
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
}
| NoPos
deriving (Eq, Ord, Read, Show)
instance HasPosition Position where
getPosition = id
setPosition = const
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
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