{-# LANGUAGE CPP #-}

module Floskell.Attoparsec ( Position, parseOnly ) where

import qualified Data.Attoparsec.ByteString as AP
import qualified Data.ByteString            as B
import           Data.Semigroup             as Sem
import           Data.Word                  ( Word8 )

data Position = Position { Position -> Int
posLine :: !Int, Position -> Int
posColumn :: !Int }
    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, Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Position] -> ShowS
$cshowList :: [Position] -> ShowS
show :: Position -> String
$cshow :: Position -> String
showsPrec :: Int -> Position -> ShowS
$cshowsPrec :: Int -> Position -> ShowS
Show )

instance Sem.Semigroup Position where
    (Position Int
l Int
c) <> :: Position -> Position -> Position
<> (Position Int
l' Int
c') =
        Int -> Int -> Position
Position (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
l') (if Int
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int
c' else Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c')

instance Monoid Position where
    mempty :: Position
mempty = Int -> Int -> Position
Position Int
0 Int
0

#if !(MIN_VERSION_base(4,11,0))
    mappend = (<>)
#endif

advance :: Position -> Word8 -> Position
advance :: Position -> Word8 -> Position
advance (Position Int
l Int
_) Word8
10 = Int -> Int -> Position
Position (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0
advance (Position Int
l Int
c) Word8
_ = Int -> Int -> Position
Position Int
l (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

position :: B.ByteString -> Position
position :: ByteString -> Position
position = (Position -> Word8 -> Position)
-> Position -> ByteString -> Position
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
B.foldl' Position -> Word8 -> Position
advance Position
forall a. Monoid a => a
mempty

positionAt :: B.ByteString -> B.ByteString -> Position
positionAt :: ByteString -> ByteString -> Position
positionAt ByteString
l ByteString
r = ByteString -> Position
position (ByteString -> Position) -> ByteString -> Position
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.take (ByteString -> Int
B.length ByteString
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
r) ByteString
l

parseOnly :: AP.Parser a -> B.ByteString -> Either String a
parseOnly :: Parser a -> ByteString -> Either String a
parseOnly Parser a
p ByteString
b = case IResult ByteString a -> ByteString -> IResult ByteString a
forall i r. Monoid i => IResult i r -> i -> IResult i r
AP.feed (Parser a -> ByteString -> IResult ByteString a
forall a. Parser a -> ByteString -> Result a
AP.parse Parser a
p ByteString
b) ByteString
B.empty of
    AP.Done ByteString
_ a
x -> a -> Either String a
forall a b. b -> Either a b
Right a
x
    AP.Fail ByteString
r [String]
_ String
err -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ Position -> ShowS
parseError (ByteString -> ByteString -> Position
positionAt ByteString
b ByteString
r) String
err
    AP.Partial ByteString -> IResult ByteString a
_ -> String -> Either String a
forall a. HasCallStack => String -> a
error String
"impossible"
  where
    parseError :: Position -> ShowS
parseError (Position Int
l Int
c) String
err = String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", at line " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
c