content: {-# LANGUAGE DeriveGeneric #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE RankNTypes #-}
  -- | Source position and span information
  --
  --   Mostly taken from purescript's SourcePos definition.
  module Source.Span
  ( Span(..)
  , point
  , spanFromSrcLoc
  , Pos(..)
  , line_
  , column_
  , HasSpan(..)
  ) where
  
  import           Control.DeepSeq (NFData)
  import           Data.Aeson ((.:), (.=))
  import qualified Data.Aeson as A
  import           Data.Hashable (Hashable)
  import           GHC.Generics (Generic)
  import           GHC.Stack (SrcLoc (..))
  
  -- | A Span of position information
  data Span = Span
    { start :: {-# UNPACK #-} !Pos
    , end   :: {-# UNPACK #-} !Pos
    }
    deriving (Eq, Ord, Generic, Show)
  
  instance Hashable Span
  instance NFData   Span
  
  instance Semigroup Span where
    Span start1 end1 <> Span start2 end2 = Span (min start1 start2) (max end1 end2)
  
  instance A.ToJSON Span where
    toJSON s = A.object
      [ "start" .= start s
      , "end"   .= end   s
      ]
  
  instance A.FromJSON Span where
    parseJSON = A.withObject "Span" $ \o -> Span
      <$> o .: "start"
      <*> o .: "end"
  
  -- | Construct a Span with a given value for both its start and end positions.
  point :: Pos -> Span
  point p = Span p p
  
  spanFromSrcLoc :: SrcLoc -> Span
  spanFromSrcLoc s = Span (Pos (srcLocStartLine s) (srcLocStartCol s)) (Pos (srcLocEndLine s) (srcLocEndCol s))
  
  
  -- | Source position information.
  -- The 'Pos' values associated with ASTs returned from tree-sitter
  -- 'Unmarshal' instances are zero-indexed. Unless you are displaying
  -- span information to a user, you should write your code assuming
  -- zero-indexing.
  data Pos = Pos
    { line   :: {-# UNPACK #-} !Int
    , column :: {-# UNPACK #-} !Int
    }
    deriving (Eq, Ord, Generic, Show)
  
  instance Hashable Pos
  instance NFData   Pos
  
  instance A.ToJSON Pos where
    toJSON p = A.toJSON
      [ line   p
      , column p
      ]
  
  instance A.FromJSON Pos where
    parseJSON arr = do
      [ line, col ] <- A.parseJSON arr
      pure $ Pos line col
  
  line_, column_ :: Lens' Pos Int
  line_   = lens line   (\p l -> p { line   = l })
  column_ = lens column (\p l -> p { column = l })
  
  
  -- | "Classy-fields" interface for data types that have spans.
  class HasSpan a where
    span_ :: Lens' a Span
  
    start_ :: Lens' a Pos
    start_ = span_.start_
    {-# INLINE start_ #-}
  
    end_ :: Lens' a Pos
    end_ = span_.end_
    {-# INLINE end_ #-}
  
  instance HasSpan Span where
    span_  = id
    {-# INLINE span_ #-}
  
    start_ = lens start (\s t -> s { start = t })
    {-# INLINE start_ #-}
  
    end_   = lens end   (\s t -> s { end   = t })
    {-# INLINE end_ #-}
  
  
  type Lens' s a = forall f . Functor f => (a -> f a) -> (s -> f s)
  
  lens :: (s -> a) -> (s -> a -> s) -> Lens' s a
  lens get put afa s = fmap (put s) (afa (get s))
  {-# INLINE lens #-}
  