{-|
Module      : Prosidy.Optics.Source
Description : Profunctor optics over Prosidy types.
Copyright   : ©2020 James Alexander Feldman-Crough
License     : MPL-2.0
Maintainer  : alex@fldcr.com
-}
module Prosidy.Optics.Source
    ( -- * Classy optics; implementable on all types with a location
      HasLocation(..)
    , offset
      -- ** Read-only optics.
    , column
    , line
    , source

      -- * Conversion utilities
    , sparse
    )
where

import           Prosidy.Types
import           Prosidy.Source
import           Prosidy.Optics.Internal

-- | 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 :: Affine' t Location

instance HasLocation Location where
    location :: Optic p f Location Location Location Location
location = Optic p f Location Location Location Location
forall a. a -> a
id
    {-# INLINE location #-}

instance HasLocation (Tag a) where
    location :: Optic p f (Tag a) (Tag a) Location Location
location = (Tag a -> Maybe Location)
-> (Tag a -> Location -> Tag a) -> Affine' (Tag a) Location
forall s a b. (s -> Maybe a) -> (s -> b -> s) -> Affine s s a b
affine' Tag a -> Maybe Location
forall a. Tag a -> Maybe Location
tagLocation (\d :: Tag a
d l :: Location
l -> Tag a
d { tagLocation :: Maybe Location
tagLocation = Location -> Maybe Location
forall a. a -> Maybe a
Just Location
l })
    {-# INLINE location #-}

instance HasLocation (Region a) where
    location :: Optic p f (Region a) (Region a) Location Location
location = (Region a -> Maybe Location)
-> (Region a -> Location -> Region a)
-> Affine' (Region a) Location
forall s a b. (s -> Maybe a) -> (s -> b -> s) -> Affine s s a b
affine' Region a -> Maybe Location
forall a. Region a -> Maybe Location
regionLocation (\d :: Region a
d l :: Location
l -> Region a
d { regionLocation :: Maybe Location
regionLocation = Location -> Maybe Location
forall a. a -> Maybe a
Just Location
l })
    {-# INLINE location #-}

instance HasLocation Fragment where
    location :: Optic p f Fragment Fragment Location Location
location =
        (Fragment -> Maybe Location)
-> (Fragment -> Location -> Fragment) -> Affine' Fragment Location
forall s a b. (s -> Maybe a) -> (s -> b -> s) -> Affine s s a b
affine' Fragment -> Maybe Location
fragmentLocation (\d :: Fragment
d l :: Location
l -> Fragment
d { fragmentLocation :: Maybe Location
fragmentLocation = Location -> Maybe Location
forall a. a -> Maybe a
Just Location
l })
    {-# INLINE location #-}

instance HasLocation Paragraph where
    location :: Optic p f Paragraph Paragraph Location Location
location =
        (Paragraph -> Maybe Location)
-> (Paragraph -> Location -> Paragraph)
-> Affine' Paragraph Location
forall s a b. (s -> Maybe a) -> (s -> b -> s) -> Affine s s a b
affine' Paragraph -> Maybe Location
paragraphLocation (\d :: Paragraph
d l :: Location
l -> Paragraph
d { paragraphLocation :: Maybe Location
paragraphLocation = Location -> Maybe Location
forall a. a -> Maybe a
Just Location
l })
    {-# INLINE location #-}

instance HasLocation Block where
    location :: Optic p f Block Block Location Location
location = (Block -> Maybe Location)
-> (Block -> Location -> Block) -> Affine' Block Location
forall s a b. (s -> Maybe a) -> (s -> b -> s) -> Affine s s a b
affine' Block -> Maybe Location
get Block -> Location -> Block
set
      where
        get :: Block -> Maybe Location
get (BlockLiteral   lit :: LiteralTag
lit) = LiteralTag -> Maybe Location
forall a. Tag a -> Maybe Location
tagLocation LiteralTag
lit
        get (BlockParagraph p :: Paragraph
p  ) = Paragraph -> Maybe Location
paragraphLocation Paragraph
p
        get (BlockTag       tag :: BlockTag
tag) = BlockTag -> Maybe Location
forall a. Tag a -> Maybe Location
tagLocation BlockTag
tag
        set :: Block -> Location -> Block
set (BlockLiteral lit :: LiteralTag
lit) l :: Location
l = LiteralTag -> Block
BlockLiteral LiteralTag
lit { tagLocation :: Maybe Location
tagLocation = Location -> Maybe Location
forall a. a -> Maybe a
Just Location
l }
        set (BlockParagraph p :: Paragraph
p) l :: Location
l =
            Paragraph -> Block
BlockParagraph Paragraph
p { paragraphLocation :: Maybe Location
paragraphLocation = Location -> Maybe Location
forall a. a -> Maybe a
Just Location
l }
        set (BlockTag tag :: BlockTag
tag) l :: Location
l = BlockTag -> Block
BlockTag BlockTag
tag { tagLocation :: Maybe Location
tagLocation = Location -> Maybe Location
forall a. a -> Maybe a
Just Location
l }
    {-# INLINE location #-}

instance HasLocation Inline where
    location :: Optic p f Inline Inline Location Location
location = (Inline -> Maybe Location)
-> (Inline -> Location -> Inline) -> Affine' Inline Location
forall s a b. (s -> Maybe a) -> (s -> b -> s) -> Affine s s a b
affine' Inline -> Maybe Location
get Inline -> Location -> Inline
set
      where
        get :: Inline -> Maybe Location
get Break            = Maybe Location
forall a. Maybe a
Nothing
        get (InlineTag  tag :: InlineTag
tag) = InlineTag -> Maybe Location
forall a. Tag a -> Maybe Location
tagLocation InlineTag
tag
        get (InlineText f :: Fragment
f  ) = Fragment -> Maybe Location
fragmentLocation Fragment
f
        set :: Inline -> Location -> Inline
set Break            _ = Inline
Break
        set (InlineTag  tag :: InlineTag
tag) l :: Location
l = InlineTag -> Inline
InlineTag InlineTag
tag { tagLocation :: Maybe Location
tagLocation = Location -> Maybe Location
forall a. a -> Maybe a
Just Location
l }
        set (InlineText f :: Fragment
f  ) l :: Location
l = Fragment -> Inline
InlineText Fragment
f { fragmentLocation :: Maybe Location
fragmentLocation = Location -> Maybe Location
forall a. a -> Maybe a
Just Location
l }
    {-# INLINE location #-}

-- | 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 => Affine' l Offset
offset :: Affine' l Offset
offset = Optic p f l l Location Location
forall t. HasLocation t => Affine' t Location
location Optic p f l l Location Location
-> (p Offset (f Offset) -> p Location (f Location))
-> p Offset (f Offset)
-> p l (f l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic p f Location Location SparseLocation SparseLocation
Iso' Location SparseLocation
sparse Optic p f Location Location SparseLocation SparseLocation
-> (p Offset (f Offset) -> p SparseLocation (f SparseLocation))
-> p Offset (f Offset)
-> p Location (f Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SparseLocation -> Offset)
-> (SparseLocation -> Offset -> SparseLocation)
-> Lens SparseLocation SparseLocation Offset Offset
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    SparseLocation -> Offset
sparseLocationOffset
    (\sl :: SparseLocation
sl x :: Offset
x -> SparseLocation
sl { sparseLocationOffset :: Offset
sparseLocationOffset = Offset
x })
{-# INLINE offset #-}

-- | 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, Contravariant f, Applicative f) => Optic' (->) f l Column
column :: Optic' (->) f l Column
column = Optic (->) f l l Location Location
forall t. HasLocation t => Affine' t Location
location Optic (->) f l l Location Location
-> ((Column -> f Column) -> Location -> f Location)
-> Optic' (->) f l Column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Location -> Column) -> Getter Location Column
forall s a. (s -> a) -> Getter s a
to Location -> Column
locationColumn
{-# INLINE column #-}

-- | 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, Contravariant f, Applicative f) => Optic' (->) f l Line
line :: Optic' (->) f l Line
line = Optic (->) f l l Location Location
forall t. HasLocation t => Affine' t Location
location Optic (->) f l l Location Location
-> ((Line -> f Line) -> Location -> f Location)
-> Optic' (->) f l Line
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Location -> Line) -> Getter Location Line
forall s a. (s -> a) -> Getter s a
to Location -> Line
locationLine
{-# INLINE line #-}

-- | Fetch the 'Source' a value was parsed from. Modifications are not allowed 
-- as the 'line', 'offset', and 'column' may become inconsistent.
source
    :: (HasLocation l, Contravariant f, Applicative f) => Optic' (->) f l Source
source :: Optic' (->) f l Source
source = Optic (->) f l l Location Location
forall t. HasLocation t => Affine' t Location
location Optic (->) f l l Location Location
-> ((Source -> f Source) -> Location -> f Location)
-> Optic' (->) f l Source
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Location -> Source) -> Getter Location Source
forall s a. (s -> a) -> Getter s a
to Location -> Source
locationSource
{-# INLINE source #-}

-- | An isomorphism between 'Location' and 'SparseLocation'. This is allowed
-- because although a 'Location' has strictly more data than a 'SparseLocation',
-- those values are denormalizations of values within 'SparseLocation'.
sparse :: Iso' Location SparseLocation
sparse :: Optic p f Location Location SparseLocation SparseLocation
sparse = (Location -> SparseLocation)
-> (SparseLocation -> Location) -> Iso' Location SparseLocation
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Location -> SparseLocation
stripLocation SparseLocation -> Location
enrichLocation
{-# INLINE sparse #-}