Browse Source

Add `HasLocation` instaces for a number of types. (#7)

Formatting

More documentation

Add locations where needed

Co-authored-by: Alex Feldman-Crough <alex@fldcr.com>
Reviewed-on: #7
master
alex 1 year ago
parent
commit
75a79c49fc
  1. 2
      CHANGELOG
  2. 28
      src/Prosidy/Optics/Source.hs
  3. 8
      src/Prosidy/Optics/Types.hs
  4. 4
      src/Prosidy/Parse.hs
  5. 23
      src/Prosidy/Types.hs

2
CHANGELOG

@ -1,5 +1,7 @@
# v1.6 _(2020-03-01)_
- Removed an erroneous `Monoid` constraint from `SeriesNE`
- Added locations to a few node types.
- Wrapped 'Text' nodes in 'Fragment'.
# v1.5.0.1 _(2020-02-24)_
- Added `CHANGELOG` to its own file.

28
src/Prosidy/Optics/Source.hs

@ -42,11 +42,39 @@ instance HasLocation (Region a) where
location = affine' regionLocation (\d l -> d { regionLocation = Just l })
{-# INLINE location #-}
instance HasLocation Fragment where
location =
affine' fragmentLocation (\d l -> d { fragmentLocation = Just l })
{-# INLINE location #-}
instance HasLocation Paragraph where
location =
affine' paragraphLocation (\d l -> d { paragraphLocation = Just l })
{-# INLINE location #-}
instance HasLocation Block where
location = affine' get set
where
get (BlockLiteral lit) = tagLocation lit
get (BlockParagraph p ) = paragraphLocation p
get (BlockTag tag) = tagLocation tag
set (BlockLiteral lit) l = BlockLiteral lit { tagLocation = Just l }
set (BlockParagraph p) l =
BlockParagraph p { paragraphLocation = Just l }
set (BlockTag tag) l = BlockTag tag { tagLocation = Just l }
{-# INLINE location #-}
instance HasLocation Inline where
location = affine' get set
where
get Break = Nothing
get (InlineTag tag) = tagLocation tag
get (InlineText f ) = fragmentLocation f
set Break _ = Break
set (InlineTag tag) l = InlineTag tag { tagLocation = Just l }
set (InlineText f ) l = InlineText f { fragmentLocation = Just 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.

8
src/Prosidy/Optics/Types.hs

@ -20,6 +20,7 @@ module Prosidy.Optics.Types
, HasContent(..)
-- * Accessors for fields not otherwise covered
, tag
, fragment
-- * Conversion between 'Tag's and 'Region's.
, tagged
-- * Prisms on 'Block' contexts
@ -156,6 +157,11 @@ tag :: Lens' (Tag a) Key
tag = lens tagName (\t n -> t { tagName = n })
{-# INLINE tag #-}
-------------------------------------------------------------------------------
-- | Get the contents of a 'Fragment'.
fragment :: Lens' Fragment Text
fragment = lens fragmentText (\f t -> f { fragmentText = t })
-------------------------------------------------------------------------------
-- | Focus on the inner 'Region' of 'Tag's with a name. This can be used to
-- filter 'Tag's to a specific subset for manipulation.
@ -190,7 +196,7 @@ _InlineTag = prism' InlineTag $ \case
_ -> Nothing
-- | Focus only on text nodes.
_Text :: Prism' Inline Text
_Text :: Prism' Inline Fragment
_Text = prism' InlineText $ \case
InlineText t -> Just t
_ -> Nothing

4
src/Prosidy/Parse.hs

@ -360,8 +360,8 @@ quotedText = do
skipSpaces
pure . Text.Lazy.toStrict . fold $ parts
fragment :: P Text
fragment = text
fragment :: P Fragment
fragment = annotateSource $ Fragment <$> text
text :: P Text
text = do

23
src/Prosidy/Types.hs

@ -38,6 +38,8 @@ module Prosidy.Types
-- * Common structures
, Metadata(..)
, Region(..)
-- * Textual fragments
, Fragment(..)
-- * Utility wrappers
, module X
)
@ -68,6 +70,7 @@ import Data.Hashable ( Hashable )
import Data.Aeson ( ToJSON(..)
, FromJSON(..)
, withObject
, withText
, (.:)
, (.=)
, object
@ -154,6 +157,24 @@ documentToRegion (Document md ct) = Region md ct Nothing
regionToDocument :: Region (Series Block) -> Document
regionToDocument (Region md ct _) = Document md ct
-------------------------------------------------------------------------------
-- | Plain text, possibly annotated with a 'Location'.
data Fragment = Fragment
{ fragmentText :: Text
-- ^ Access the underlying 'Text'.
, fragmentLocation :: Maybe Location
-- ^ The location of the 'Text' in the source code.
}
deriving stock (Eq, Show, Generic)
deriving anyclass (Hashable, Binary, NFData)
instance FromJSON Fragment where
parseJSON = withText "Fragment" $ pure . flip Fragment Nothing
instance ToJSON Fragment where
toEncoding = toEncoding . fragmentText
toJSON = toJSON . fragmentText
-------------------------------------------------------------------------------
-- | A sum type enumerating allowed types inside of an inline context.
data Inline =
@ -166,7 +187,7 @@ data Inline =
| InlineTag InlineTag
-- ^ A 'Tag' which contains only 'Inline' items. These tags begin with the
-- @#@ sigil in source.
| InlineText Text
| InlineText Fragment
-- ^ A fragment of plain text.
deriving stock (Eq, Show, Generic)
deriving anyclass (Hashable, Binary, NFData)

Loading…
Cancel
Save