module Curry.Base.Position
(
HasPosition (..), Position (..), (@>)
, showPosition, ppPosition, ppCompactLine, ppLine, showLine
, first, next, incr, tab, tabWidth, nl
) where
import Prelude hiding ((<>))
import Data.Binary
import Control.Monad
import System.FilePath
import Curry.Base.Pretty
class HasPosition a where
getPosition :: a -> Position
getPosition _ = Position
NoPos
setPosition :: Position -> a -> a
setPosition _ = a -> a
forall a. a -> a
id
(@>) :: (HasPosition a, HasPosition b) => a -> b -> a
x :: a
x @> :: a -> b -> a
@> y :: b
y = Position -> a -> a
forall a. HasPosition a => Position -> a -> a
setPosition (b -> Position
forall a. HasPosition a => a -> Position
getPosition b
y) a
x
data Position
= Position
{ Position -> FilePath
file :: FilePath
, Position -> Int
line :: Int
, Position -> Int
column :: Int
}
| NoPos
deriving (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c== :: Position -> Position -> Bool
Eq, Eq Position
Eq Position =>
(Position -> Position -> Ordering)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Bool)
-> (Position -> Position -> Position)
-> (Position -> Position -> Position)
-> Ord Position
Position -> Position -> Bool
Position -> Position -> Ordering
Position -> Position -> Position
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Position -> Position -> Position
$cmin :: Position -> Position -> Position
max :: Position -> Position -> Position
$cmax :: Position -> Position -> Position
>= :: Position -> Position -> Bool
$c>= :: Position -> Position -> Bool
> :: Position -> Position -> Bool
$c> :: Position -> Position -> Bool
<= :: Position -> Position -> Bool
$c<= :: Position -> Position -> Bool
< :: Position -> Position -> Bool
$c< :: Position -> Position -> Bool
compare :: Position -> Position -> Ordering
$ccompare :: Position -> Position -> Ordering
$cp1Ord :: Eq Position
Ord, ReadPrec [Position]
ReadPrec Position
Int -> ReadS Position
ReadS [Position]
(Int -> ReadS Position)
-> ReadS [Position]
-> ReadPrec Position
-> ReadPrec [Position]
-> Read Position
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Position]
$creadListPrec :: ReadPrec [Position]
readPrec :: ReadPrec Position
$creadPrec :: ReadPrec Position
readList :: ReadS [Position]
$creadList :: ReadS [Position]
readsPrec :: Int -> ReadS Position
$creadsPrec :: Int -> ReadS Position
Read, Int -> Position -> ShowS
[Position] -> ShowS
Position -> FilePath
(Int -> Position -> ShowS)
-> (Position -> FilePath) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> FilePath
$cshow :: Position -> FilePath
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show)
instance HasPosition Position where
getPosition :: Position -> Position
getPosition = Position -> Position
forall a. a -> a
id
setPosition :: Position -> Position -> Position
setPosition = Position -> Position -> Position
forall a b. a -> b -> a
const
instance Pretty Position where
pPrint :: Position -> Doc
pPrint = Position -> Doc
ppPosition
instance Binary Position where
put :: Position -> Put
put (Position _ l :: Int
l c :: Int
c) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
l Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> Put
forall t. Binary t => t -> Put
put Int
c
put NoPos = Word8 -> Put
putWord8 1
get :: Get Position
get = do
Word8
x <- Get Word8
getWord8
case Word8
x of
0 -> (Int -> Int -> Position) -> Get Int -> Get Int -> Get Position
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (FilePath -> Int -> Int -> Position
Position "") Get Int
forall t. Binary t => Get t
get Get Int
forall t. Binary t => Get t
get
1 -> Position -> Get Position
forall (m :: * -> *) a. Monad m => a -> m a
return Position
NoPos
_ -> FilePath -> Get Position
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail "Not a valid encoding for a Position"
showPosition :: Position -> String
showPosition :: Position -> FilePath
showPosition = Doc -> FilePath
forall a. Show a => a -> FilePath
show (Doc -> FilePath) -> (Position -> Doc) -> Position -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Doc
ppPosition
ppPosition :: Position -> Doc
ppPosition :: Position -> Doc
ppPosition p :: Position
p@(Position f :: FilePath
f _ _)
| FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
f = Doc
lineCol
| Bool
otherwise = FilePath -> Doc
text (ShowS
normalise FilePath
f) Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<+> Doc
lineCol
where lineCol :: Doc
lineCol = Position -> Doc
ppLine Position
p
ppPosition _ = Doc
empty
ppCompactLine :: Position -> Doc
ppCompactLine :: Position -> Doc
ppCompactLine (Position _ l :: Int
l c :: Int
c) = FilePath -> Doc
text (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
l)
Doc -> Doc -> Doc
<> if Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Doc
empty else (Doc
colon Doc -> Doc -> Doc
<> FilePath -> Doc
text (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
c))
ppCompactLine _ = Doc
empty
ppLine :: Position -> Doc
ppLine :: Position -> Doc
ppLine (Position _ l :: Int
l c :: Int
c) = FilePath -> Doc
text "line" Doc -> Doc -> Doc
<+> FilePath -> Doc
text (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
l)
Doc -> Doc -> Doc
<> if Int
c Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then Doc
empty else FilePath -> Doc
text ('.' Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> FilePath
forall a. Show a => a -> FilePath
show Int
c)
ppLine _ = Doc
empty
showLine :: Position -> String
showLine :: Position -> FilePath
showLine = Doc -> FilePath
forall a. Show a => a -> FilePath
show (Doc -> FilePath) -> (Position -> Doc) -> Position -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> Doc
ppLine
first :: FilePath -> Position
first :: FilePath -> Position
first fn :: FilePath
fn = FilePath -> Int -> Int -> Position
Position FilePath
fn 1 1
next :: Position -> Position
next :: Position -> Position
next = (Position -> Int -> Position) -> Int -> Position -> Position
forall a b c. (a -> b -> c) -> b -> a -> c
flip Position -> Int -> Position
incr 1
incr :: Position -> Int -> Position
incr :: Position -> Int -> Position
incr p :: Position
p@Position { column :: Position -> Int
column = Int
c } n :: Int
n = Position
p { column :: Int
column = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n }
incr p :: Position
p _ = Position
p
tabWidth :: Int
tabWidth :: Int
tabWidth = 8
tab :: Position -> Position
tab :: Position -> Position
tab p :: Position
p@Position { column :: Position -> Int
column = Int
c }
= Position
p { column :: Int
column = Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
tabWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
tabWidth }
tab p :: Position
p = Position
p
nl :: Position -> Position
nl :: Position -> Position
nl p :: Position
p@Position { line :: Position -> Int
line = Int
l } = Position
p { line :: Int
line = Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1, column :: Int
column = 1 }
nl p :: Position
p = Position
p