{-# LANGUAGE DeriveGeneric, DerivingVia, 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 Data.Monoid.Generic
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
/= :: Loc -> Loc -> Bool
$c/= :: Loc -> Loc -> Bool
== :: Loc -> Loc -> Bool
$c== :: 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
min :: Loc -> Loc -> Loc
$cmin :: Loc -> Loc -> Loc
max :: Loc -> Loc -> Loc
$cmax :: Loc -> Loc -> Loc
>= :: Loc -> Loc -> Bool
$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
compare :: Loc -> Loc -> Ordering
$ccompare :: Loc -> Loc -> Ordering
$cp1Ord :: Eq 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
showList :: [Loc] -> ShowS
$cshowList :: [Loc] -> ShowS
show :: Loc -> String
$cshow :: Loc -> String
showsPrec :: Int -> Loc -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep Loc x -> Loc
$cfrom :: forall x. Loc -> Rep Loc x
Generic)
  deriving b -> Loc -> Loc
NonEmpty Loc -> Loc
Loc -> Loc -> Loc
(Loc -> Loc -> Loc)
-> (NonEmpty Loc -> Loc)
-> (forall b. Integral b => b -> Loc -> Loc)
-> Semigroup Loc
forall b. Integral b => b -> Loc -> Loc
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Loc -> Loc
$cstimes :: forall b. Integral b => b -> Loc -> Loc
sconcat :: NonEmpty Loc -> Loc
$csconcat :: NonEmpty Loc -> Loc
<> :: Loc -> Loc -> Loc
$c<> :: Loc -> Loc -> Loc
Semigroup via GenericSemigroup Loc

instance Hashable Loc
instance NFData   Loc

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

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

byteRange_ :: Lens' Loc Range
byteRange_ :: (Range -> f Range) -> Loc -> f Loc
byteRange_ = (Loc -> Range) -> (Loc -> Range -> Loc) -> Lens' Loc Range
forall s a. (s -> a) -> (s -> a -> s) -> Lens' s a
lens Loc -> Range
byteRange (\l :: Loc
l r :: 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 :: (s -> a) -> (s -> a -> s) -> Lens' s a
lens get :: s -> a
get put :: s -> a -> s
put afa :: a -> f a
afa s :: s
s = (a -> s) -> f a -> f s
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 #-}