{- |
Copyright: © 2020 James Alexander Feldman-Crough
License: MPL-2.0
-}
module ProSource.HasLocation
    ( -- * Classy optics; implementable on all types with a location
      HasLocation(..), offset
      -- ** Read-only optics
    , column, line, source
    ) where

import ProSource.Location
import ProSource.Units
import ProSource.SparseLocation
import ProSource.Source
import ProSource.LocationOps

-- | A classy optic for selecting the 'Location' from a value. Note that 'location' is affine: a 'Location' can't be attached to a value which does not -- already have one, and not all values with an instance of 'HasLocation' have a location.
class HasLocation t where
    location :: AffineTraversal' t Location

instance HasLocation Location where
    location :: AffineTraversal' Location Location
location = Optic An_Iso NoIx Location Location Location Location
-> AffineTraversal' Location Location
forall destKind srcKind (is :: IxList) s t a b.
Is srcKind destKind =>
Optic srcKind is s t a b -> Optic destKind is s t a b
castOptic Optic An_Iso NoIx Location Location Location Location
forall a. Iso' a a
simple

-- | Focus on the 'Offset' from a value parsed from a source file. If the 'Offset' is modified, note that the resulting 'column' and 'line' will /also/ be modified as they are denormalizations of this value.
offset :: HasLocation l => AffineTraversal' l Offset
offset :: AffineTraversal' l Offset
offset = AffineTraversal' l Location
forall t. HasLocation t => AffineTraversal' t Location
location AffineTraversal' l Location
-> Optic
     An_Iso NoIx Location Location SparseLocation SparseLocation
-> Optic An_AffineTraversal NoIx l l SparseLocation SparseLocation
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic An_Iso NoIx Location Location SparseLocation SparseLocation
sparse Optic An_AffineTraversal NoIx l l SparseLocation SparseLocation
-> Optic A_Lens NoIx SparseLocation SparseLocation Offset Offset
-> AffineTraversal' l Offset
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (SparseLocation -> Offset)
-> (SparseLocation -> Offset -> SparseLocation)
-> Optic A_Lens NoIx SparseLocation SparseLocation Offset Offset
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    SparseLocation -> Offset
sparseLocationOffset
    (\SparseLocation
sl Offset
x -> SparseLocation
sl { sparseLocationOffset :: Offset
sparseLocationOffset = Offset
x })

-- | Fetch the 'Column' from a value parsed from a source file. Modifications are not allowed as the 'offset' and 'line' may become inconsistent.
column :: HasLocation l => AffineFold l Column
column :: AffineFold l Column
column = AffineTraversal' l Location
forall t. HasLocation t => AffineTraversal' t Location
location AffineTraversal' l Location
-> Optic A_Getter NoIx Location Location Column Column
-> AffineFold l Column
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Location -> Column)
-> Optic A_Getter NoIx Location Location Column Column
forall s a. (s -> a) -> Getter s a
to Location -> Column
locationColumn

-- | Fetch the 'Line' from a value parsed from a source file. Modifications are not allowed as the 'offset' and 'column' may become inconsistent.
line :: HasLocation l => AffineFold l Line
line :: AffineFold l Line
line = AffineTraversal' l Location
forall t. HasLocation t => AffineTraversal' t Location
location AffineTraversal' l Location
-> Optic A_Getter NoIx Location Location Line Line
-> AffineFold l Line
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Location -> Line)
-> Optic A_Getter NoIx Location Location Line Line
forall s a. (s -> a) -> Getter s a
to Location -> Line
locationLine

-- | Fetch the 'Source' a value was parsed from. Modifications are not allowed as the 'line', 'offset', and 'column' may become inconsistent.
source :: HasLocation l => AffineFold l Source
source :: AffineFold l Source
source = AffineTraversal' l Location
forall t. HasLocation t => AffineTraversal' t Location
location AffineTraversal' l Location
-> Optic A_Getter NoIx Location Location Source Source
-> AffineFold l Source
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Location -> Source)
-> Optic A_Getter NoIx Location Location Source Source
forall s a. (s -> a) -> Getter s a
to Location -> Source
locationSource