-- Copyright (c) 2017 Uber Technologies, Inc. -- -- Permission is hereby granted, free of charge, to any person obtaining a copy -- of this software and associated documentation files (the "Software"), to deal -- in the Software without restriction, including without limitation the rights -- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell -- copies of the Software, and to permit persons to whom the Software is -- furnished to do so, subject to the following conditions: -- -- The above copyright notice and this permission notice shall be included in -- all copies or substantial portions of the Software. -- -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR -- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE -- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER -- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, -- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -- THE SOFTWARE. {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} module Database.Sql.Position where import Data.Int (Int64) import Data.Text.Lazy (Text) import qualified Data.Text.Lazy as TL import Data.Aeson import Data.Semigroup (Semigroup (..)) import Data.Data (Data) import GHC.Generics (Generic) data Position = Position { positionLine :: Int64 , positionColumn :: Int64 , positionOffset :: Int64 } deriving (Generic, Data, Show, Eq, Ord) data Range = Range { start :: Position , end :: Position } deriving (Generic, Data, Show, Eq, Ord) instance Semigroup Range where Range s e <> Range s' e' = Range (min s s') (max e e') infixr 6 ?<> (?<>) :: Semigroup a => a -> Maybe a -> a r ?<> Nothing = r r ?<> (Just r') = r <> r' advanceHorizontal :: Int64 -> Position -> Position advanceHorizontal n p = p { positionColumn = positionColumn p + n , positionOffset = positionOffset p + n } advanceVertical :: Int64 -> Position -> Position advanceVertical n p = p { positionLine = positionLine p + n , positionColumn = if n > 0 then 0 else positionColumn p , positionOffset = positionOffset p + n } advance :: Text -> Position -> Position advance t p = let newlines = TL.count "\n" t in p { positionLine = positionLine p + newlines , positionColumn = if newlines == 0 then positionColumn p + TL.length t else TL.length $ snd $ TL.breakOnEnd "\n" t , positionOffset = positionOffset p + TL.length t } instance ToJSON Position where toJSON Position {..} = object [ "line" .= positionLine , "column" .= positionColumn , "offset" .= positionOffset ] instance ToJSON Range where toJSON Range {..} = object [ "start" .= start , "end" .= end ] instance FromJSON Position where parseJSON (Object o) = do positionLine <- o .: "line" positionColumn <- o .: "column" positionOffset <- o .: "offset" return Position{..} parseJSON v = fail $ "don't know how to parse as Position: " ++ show v instance FromJSON Range where parseJSON (Object o) = do start <- o .: "start" end <- o .: "end" return Range{..} parseJSON v = fail $ "don't know how to parse as Range: " ++ show v