{-# LANGUAGE DeriveGeneric, RankNTypes, NamedFieldPuns, OverloadedStrings #-}
module Source.Loc
( Loc(..)
, byteRange_
, Span(Span)
, Range(Range)
) where

import Control.DeepSeq (NFData)
import Data.Aeson (ToJSON(..), object, (.=))
import Data.Hashable (Hashable)
import GHC.Generics (Generic)
import Prelude hiding (span)
import Source.Range
import Source.Span

data Loc = Loc
  { Loc -> Range
byteRange :: {-# UNPACK #-} !Range
  , Loc -> Span
span      :: {-# UNPACK #-} !Span
  }
  deriving (Loc -> Loc -> Bool
(Loc -> Loc -> Bool) -> (Loc -> Loc -> Bool) -> Eq Loc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Loc -> Loc -> Bool
== :: Loc -> Loc -> Bool
$c/= :: Loc -> Loc -> Bool
/= :: Loc -> Loc -> Bool
Eq, Eq Loc
Eq Loc
-> (Loc -> Loc -> Ordering)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Bool)
-> (Loc -> Loc -> Loc)
-> (Loc -> Loc -> Loc)
-> Ord Loc
Loc -> Loc -> Bool
Loc -> Loc -> Ordering
Loc -> Loc -> Loc
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
$ccompare :: Loc -> Loc -> Ordering
compare :: Loc -> Loc -> Ordering
$c< :: Loc -> Loc -> Bool
< :: Loc -> Loc -> Bool
$c<= :: Loc -> Loc -> Bool
<= :: Loc -> Loc -> Bool
$c> :: Loc -> Loc -> Bool
> :: Loc -> Loc -> Bool
$c>= :: Loc -> Loc -> Bool
>= :: Loc -> Loc -> Bool
$cmax :: Loc -> Loc -> Loc
max :: Loc -> Loc -> Loc
$cmin :: Loc -> Loc -> Loc
min :: Loc -> Loc -> Loc
Ord, Int -> Loc -> ShowS
[Loc] -> ShowS
Loc -> String
(Int -> Loc -> ShowS)
-> (Loc -> String) -> ([Loc] -> ShowS) -> Show Loc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Loc -> ShowS
showsPrec :: Int -> Loc -> ShowS
$cshow :: Loc -> String
show :: Loc -> String
$cshowList :: [Loc] -> ShowS
showList :: [Loc] -> ShowS
Show, (forall x. Loc -> Rep Loc x)
-> (forall x. Rep Loc x -> Loc) -> Generic Loc
forall x. Rep Loc x -> Loc
forall x. Loc -> Rep Loc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Loc -> Rep Loc x
from :: forall x. Loc -> Rep Loc x
$cto :: forall x. Rep Loc x -> Loc
to :: forall x. Rep Loc x -> Loc
Generic)

instance Semigroup Loc where
  Loc Range
b1 Span
s1 <> :: Loc -> Loc -> Loc
<> Loc Range
b2 Span
s2 = Range -> Span -> Loc
Loc (Range
b1 Range -> Range -> Range
forall a. Semigroup a => a -> a -> a
<> Range
b2) (Span
s1 Span -> Span -> Span
forall a. Semigroup a => a -> a -> a
<> Span
s2)

instance Hashable Loc
instance NFData   Loc

instance HasSpan Loc where
  span_ :: Lens' Loc Span
span_ = (Loc -> Span) -> (Loc -> Span -> Loc) -> Lens' Loc Span
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens Loc -> Span
span (\Loc
l Span
s -> Loc
l { span :: Span
span = Span
s })
  {-# INLINE span_ #-}

instance ToJSON Loc where
  toJSON :: Loc -> Value
toJSON Loc{Range
byteRange :: Loc -> Range
byteRange :: Range
byteRange, Span
span :: Loc -> Span
span :: Span
span} = [Pair] -> Value
object [Key
"sourceRange" Key -> Range -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Range
byteRange
                                      , Key
"sourceSpan" Key -> Span -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Span
span]

byteRange_ :: Lens' Loc Range
byteRange_ :: Lens' Loc Range
byteRange_ = (Loc -> Range) -> (Loc -> Range -> Loc) -> Lens' Loc Range
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens Loc -> Range
byteRange (\Loc
l Range
r -> Loc
l { byteRange :: Range
byteRange = Range
r })


type Lens' s a = forall f . Functor f => (a -> f a) -> (s -> f s)

lens :: (s -> a) -> (s -> a -> s) -> Lens' s a
lens :: forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens s -> a
get s -> a -> s
put a -> f a
afa s
s = (a -> s) -> f a -> f s
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (s -> a -> s
put s
s) (a -> f a
afa (s -> a
get s
s))
{-# INLINE lens #-}