{- |
    Module      :  $Header$
    Description :  SpansInfo for entities
    Copyright   :  (c) 2017 Kai-Oliver Prott
    License     :  BSD-3-clause

    Maintainer  :  fte@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

    This module implements a data type for span information for entities from a
    source file and function to operate on them. A span info consists of the
    span of the entity and a list of sub-spans whith additional information
    about location of keywords, e.g.
-}
module Curry.Base.SpanInfo
  ( SpanInfo(..), spanInfo, LayoutInfo(..), HasSpanInfo(..)
  , fromSrcSpan, fromSrcSpanBoth, getSrcSpan, setSrcSpan, spanInfoLike
  , fromSrcInfoPoints, getSrcInfoPoints, setSrcInfoPoints
  , getStartPosition, getSrcSpanEnd, setStartPosition, setEndPosition
  , spanInfo2Pos
  ) where

import Data.Binary
import Control.Monad

import Curry.Base.Position
import Curry.Base.Span

data SpanInfo = SpanInfo
    { SpanInfo -> Span
srcSpan        :: Span
    , SpanInfo -> [Span]
srcInfoPoints  :: [Span]
    }
    | NoSpanInfo
  deriving (SpanInfo -> SpanInfo -> Bool
(SpanInfo -> SpanInfo -> Bool)
-> (SpanInfo -> SpanInfo -> Bool) -> Eq SpanInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpanInfo -> SpanInfo -> Bool
$c/= :: SpanInfo -> SpanInfo -> Bool
== :: SpanInfo -> SpanInfo -> Bool
$c== :: SpanInfo -> SpanInfo -> Bool
Eq, Eq SpanInfo
Eq SpanInfo =>
(SpanInfo -> SpanInfo -> Ordering)
-> (SpanInfo -> SpanInfo -> Bool)
-> (SpanInfo -> SpanInfo -> Bool)
-> (SpanInfo -> SpanInfo -> Bool)
-> (SpanInfo -> SpanInfo -> Bool)
-> (SpanInfo -> SpanInfo -> SpanInfo)
-> (SpanInfo -> SpanInfo -> SpanInfo)
-> Ord SpanInfo
SpanInfo -> SpanInfo -> Bool
SpanInfo -> SpanInfo -> Ordering
SpanInfo -> SpanInfo -> SpanInfo
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 :: SpanInfo -> SpanInfo -> SpanInfo
$cmin :: SpanInfo -> SpanInfo -> SpanInfo
max :: SpanInfo -> SpanInfo -> SpanInfo
$cmax :: SpanInfo -> SpanInfo -> SpanInfo
>= :: SpanInfo -> SpanInfo -> Bool
$c>= :: SpanInfo -> SpanInfo -> Bool
> :: SpanInfo -> SpanInfo -> Bool
$c> :: SpanInfo -> SpanInfo -> Bool
<= :: SpanInfo -> SpanInfo -> Bool
$c<= :: SpanInfo -> SpanInfo -> Bool
< :: SpanInfo -> SpanInfo -> Bool
$c< :: SpanInfo -> SpanInfo -> Bool
compare :: SpanInfo -> SpanInfo -> Ordering
$ccompare :: SpanInfo -> SpanInfo -> Ordering
$cp1Ord :: Eq SpanInfo
Ord, ReadPrec [SpanInfo]
ReadPrec SpanInfo
Int -> ReadS SpanInfo
ReadS [SpanInfo]
(Int -> ReadS SpanInfo)
-> ReadS [SpanInfo]
-> ReadPrec SpanInfo
-> ReadPrec [SpanInfo]
-> Read SpanInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpanInfo]
$creadListPrec :: ReadPrec [SpanInfo]
readPrec :: ReadPrec SpanInfo
$creadPrec :: ReadPrec SpanInfo
readList :: ReadS [SpanInfo]
$creadList :: ReadS [SpanInfo]
readsPrec :: Int -> ReadS SpanInfo
$creadsPrec :: Int -> ReadS SpanInfo
Read, Int -> SpanInfo -> ShowS
[SpanInfo] -> ShowS
SpanInfo -> String
(Int -> SpanInfo -> ShowS)
-> (SpanInfo -> String) -> ([SpanInfo] -> ShowS) -> Show SpanInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpanInfo] -> ShowS
$cshowList :: [SpanInfo] -> ShowS
show :: SpanInfo -> String
$cshow :: SpanInfo -> String
showsPrec :: Int -> SpanInfo -> ShowS
$cshowsPrec :: Int -> SpanInfo -> ShowS
Show)

spanInfo :: Span -> [Span] -> SpanInfo
spanInfo :: Span -> [Span] -> SpanInfo
spanInfo sp :: Span
sp sps :: [Span]
sps = Span -> [Span] -> SpanInfo
SpanInfo Span
sp [Span]
sps

data LayoutInfo = ExplicitLayout [Span]
                | WhitespaceLayout
  deriving (LayoutInfo -> LayoutInfo -> Bool
(LayoutInfo -> LayoutInfo -> Bool)
-> (LayoutInfo -> LayoutInfo -> Bool) -> Eq LayoutInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LayoutInfo -> LayoutInfo -> Bool
$c/= :: LayoutInfo -> LayoutInfo -> Bool
== :: LayoutInfo -> LayoutInfo -> Bool
$c== :: LayoutInfo -> LayoutInfo -> Bool
Eq, ReadPrec [LayoutInfo]
ReadPrec LayoutInfo
Int -> ReadS LayoutInfo
ReadS [LayoutInfo]
(Int -> ReadS LayoutInfo)
-> ReadS [LayoutInfo]
-> ReadPrec LayoutInfo
-> ReadPrec [LayoutInfo]
-> Read LayoutInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LayoutInfo]
$creadListPrec :: ReadPrec [LayoutInfo]
readPrec :: ReadPrec LayoutInfo
$creadPrec :: ReadPrec LayoutInfo
readList :: ReadS [LayoutInfo]
$creadList :: ReadS [LayoutInfo]
readsPrec :: Int -> ReadS LayoutInfo
$creadsPrec :: Int -> ReadS LayoutInfo
Read, Int -> LayoutInfo -> ShowS
[LayoutInfo] -> ShowS
LayoutInfo -> String
(Int -> LayoutInfo -> ShowS)
-> (LayoutInfo -> String)
-> ([LayoutInfo] -> ShowS)
-> Show LayoutInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LayoutInfo] -> ShowS
$cshowList :: [LayoutInfo] -> ShowS
show :: LayoutInfo -> String
$cshow :: LayoutInfo -> String
showsPrec :: Int -> LayoutInfo -> ShowS
$cshowsPrec :: Int -> LayoutInfo -> ShowS
Show)

class HasPosition a => HasSpanInfo a where

  getSpanInfo :: a -> SpanInfo

  setSpanInfo :: SpanInfo -> a -> a

  updateEndPos :: a -> a
  updateEndPos = a -> a
forall a. a -> a
id

  getLayoutInfo :: a -> LayoutInfo
  getLayoutInfo = LayoutInfo -> a -> LayoutInfo
forall a b. a -> b -> a
const LayoutInfo
WhitespaceLayout

instance HasSpanInfo SpanInfo where
  getSpanInfo :: SpanInfo -> SpanInfo
getSpanInfo = SpanInfo -> SpanInfo
forall a. a -> a
id
  setSpanInfo :: SpanInfo -> SpanInfo -> SpanInfo
setSpanInfo = SpanInfo -> SpanInfo -> SpanInfo
forall a b. a -> b -> a
const

instance HasPosition SpanInfo where
  getPosition :: SpanInfo -> Position
getPosition = SpanInfo -> Position
forall a. HasSpanInfo a => a -> Position
getStartPosition
  setPosition :: Position -> SpanInfo -> SpanInfo
setPosition = Position -> SpanInfo -> SpanInfo
forall a. HasSpanInfo a => Position -> a -> a
setStartPosition

instance Binary SpanInfo where
  put :: SpanInfo -> Put
put (SpanInfo sp :: Span
sp ss :: [Span]
ss) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Span -> Put
forall t. Binary t => t -> Put
put Span
sp Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Span] -> Put
forall t. Binary t => t -> Put
put [Span]
ss
  put NoSpanInfo       = Word8 -> Put
putWord8 1

  get :: Get SpanInfo
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> (Span -> [Span] -> SpanInfo)
-> Get Span -> Get [Span] -> Get SpanInfo
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Span -> [Span] -> SpanInfo
SpanInfo Get Span
forall t. Binary t => Get t
get Get [Span]
forall t. Binary t => Get t
get
      1 -> SpanInfo -> Get SpanInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SpanInfo
NoSpanInfo
      _ -> String -> Get SpanInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Not a valid encoding for a SpanInfo"

instance Binary LayoutInfo where
  put :: LayoutInfo -> Put
put (ExplicitLayout ss :: [Span]
ss) = Word8 -> Put
putWord8 0 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Span] -> Put
forall t. Binary t => t -> Put
put [Span]
ss
  put WhitespaceLayout = Word8 -> Put
putWord8 1

  get :: Get LayoutInfo
get = do
    Word8
x <- Get Word8
getWord8
    case Word8
x of
      0 -> ([Span] -> LayoutInfo) -> Get [Span] -> Get LayoutInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Span] -> LayoutInfo
ExplicitLayout Get [Span]
forall t. Binary t => Get t
get
      1 -> LayoutInfo -> Get LayoutInfo
forall (m :: * -> *) a. Monad m => a -> m a
return LayoutInfo
WhitespaceLayout
      _ -> String -> Get LayoutInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Not a valid encoding for a LayoutInfo"

fromSrcSpan :: Span -> SpanInfo
fromSrcSpan :: Span -> SpanInfo
fromSrcSpan sp :: Span
sp = Span -> [Span] -> SpanInfo
SpanInfo Span
sp []

fromSrcSpanBoth :: Span -> SpanInfo
fromSrcSpanBoth :: Span -> SpanInfo
fromSrcSpanBoth sp :: Span
sp = Span -> [Span] -> SpanInfo
SpanInfo Span
sp [Span
sp]

getSrcSpan :: HasSpanInfo a => a -> Span
getSrcSpan :: a -> Span
getSrcSpan a :: a
a = case a -> SpanInfo
forall a. HasSpanInfo a => a -> SpanInfo
getSpanInfo a
a of
  NoSpanInfo   -> Span
NoSpan
  SpanInfo s :: Span
s _ -> Span
s

setSrcSpan :: HasSpanInfo a => Span -> a -> a
setSrcSpan :: Span -> a -> a
setSrcSpan s :: Span
s a :: a
a = case a -> SpanInfo
forall a. HasSpanInfo a => a -> SpanInfo
getSpanInfo a
a of
  NoSpanInfo     -> SpanInfo -> a -> a
forall a. HasSpanInfo a => SpanInfo -> a -> a
setSpanInfo (Span -> [Span] -> SpanInfo
SpanInfo Span
s [] ) a
a
  SpanInfo _ inf :: [Span]
inf -> SpanInfo -> a -> a
forall a. HasSpanInfo a => SpanInfo -> a -> a
setSpanInfo (Span -> [Span] -> SpanInfo
SpanInfo Span
s [Span]
inf) a
a

fromSrcInfoPoints :: [Span] -> SpanInfo
fromSrcInfoPoints :: [Span] -> SpanInfo
fromSrcInfoPoints = Span -> [Span] -> SpanInfo
SpanInfo Span
NoSpan

getSrcInfoPoints :: HasSpanInfo a => a -> [Span]
getSrcInfoPoints :: a -> [Span]
getSrcInfoPoints a :: a
a = case a -> SpanInfo
forall a. HasSpanInfo a => a -> SpanInfo
getSpanInfo a
a of
  NoSpanInfo    -> []
  SpanInfo _ xs :: [Span]
xs -> [Span]
xs

setSrcInfoPoints :: HasSpanInfo a => [Span] -> a -> a
setSrcInfoPoints :: [Span] -> a -> a
setSrcInfoPoints inf :: [Span]
inf a :: a
a = case a -> SpanInfo
forall a. HasSpanInfo a => a -> SpanInfo
getSpanInfo a
a of
  NoSpanInfo    -> SpanInfo -> a -> a
forall a. HasSpanInfo a => SpanInfo -> a -> a
setSpanInfo (Span -> [Span] -> SpanInfo
SpanInfo Span
NoSpan [Span]
inf) a
a
  SpanInfo s :: Span
s _  -> SpanInfo -> a -> a
forall a. HasSpanInfo a => SpanInfo -> a -> a
setSpanInfo (Span -> [Span] -> SpanInfo
SpanInfo Span
s      [Span]
inf) a
a

getStartPosition :: HasSpanInfo a => a -> Position
getStartPosition :: a -> Position
getStartPosition a :: a
a =  case a -> Span
forall a. HasSpanInfo a => a -> Span
getSrcSpan a
a of
  NoSpan     -> Position
NoPos
  Span _ s :: Position
s _ -> Position
s

getSrcSpanEnd :: HasSpanInfo a => a -> Position
getSrcSpanEnd :: a -> Position
getSrcSpanEnd a :: a
a = case a -> SpanInfo
forall a. HasSpanInfo a => a -> SpanInfo
getSpanInfo a
a of
  NoSpanInfo   -> Position
NoPos
  SpanInfo s :: Span
s _ -> Span -> Position
end Span
s

setStartPosition :: HasSpanInfo a => Position -> a -> a
setStartPosition :: Position -> a -> a
setStartPosition p :: Position
p a :: a
a = case a -> Span
forall a. HasSpanInfo a => a -> Span
getSrcSpan a
a of
  NoSpan     -> Span -> a -> a
forall a. HasSpanInfo a => Span -> a -> a
setSrcSpan (String -> Position -> Position -> Span
Span "" Position
p Position
NoPos) a
a
  Span f :: String
f _ e :: Position
e -> Span -> a -> a
forall a. HasSpanInfo a => Span -> a -> a
setSrcSpan (String -> Position -> Position -> Span
Span String
f  Position
p     Position
e) a
a

setEndPosition :: HasSpanInfo a => Position -> a -> a
setEndPosition :: Position -> a -> a
setEndPosition e :: Position
e a :: a
a = case a -> Span
forall a. HasSpanInfo a => a -> Span
getSrcSpan a
a of
  NoSpan     -> Span -> a -> a
forall a. HasSpanInfo a => Span -> a -> a
setSrcSpan (String -> Position -> Position -> Span
Span "" Position
NoPos Position
e) a
a
  Span f :: String
f p :: Position
p _ -> Span -> a -> a
forall a. HasSpanInfo a => Span -> a -> a
setSrcSpan (String -> Position -> Position -> Span
Span String
f  Position
p     Position
e) a
a

spanInfo2Pos :: HasSpanInfo a => a -> Position
spanInfo2Pos :: a -> Position
spanInfo2Pos = a -> Position
forall a. HasSpanInfo a => a -> Position
getStartPosition

spanInfoLike :: (HasSpanInfo a, HasSpanInfo b) => a -> b -> a
spanInfoLike :: a -> b -> a
spanInfoLike a :: a
a b :: b
b = SpanInfo -> a -> a
forall a. HasSpanInfo a => SpanInfo -> a -> a
setSpanInfo (b -> SpanInfo
forall a. HasSpanInfo a => a -> SpanInfo
getSpanInfo b
b) a
a