{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
module Prosidy.Optics.Types
(
HasMetadata(..)
, properties
, settings
, hasProperty
, atSetting
, HasContent(..)
, tag
, tagged
, _BlockTag
, _BlockLiteral
, _BlockParagraph
, _InlineTag
, _Text
, _Break
, key
, _Assoc
, _NonEmpty
, _Series
, _SeriesNE
, _Set
)
where
import Prosidy.Types
import Prosidy.Types.Assoc ( toHashMap
, fromHashMap
)
import Prosidy.Types.Series ( toSeq
, fromSeq
, toSeqNE
, fromSeqNE
)
import Prosidy.Types.Set ( toHashSet
, fromHashSet
)
import Prosidy.Optics.Internal
import Data.Text ( Text )
import Data.Sequence ( Seq )
import Data.HashMap.Strict ( HashMap )
import Data.HashSet ( HashSet )
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
class HasMetadata t where
metadata :: Lens' t Metadata
instance HasMetadata Document where
metadata :: Optic p f Document Document Metadata Metadata
metadata = (Document -> Metadata)
-> (Document -> Metadata -> Document) -> Lens' Document Metadata
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Document -> Metadata
documentMetadata (\d :: Document
d m :: Metadata
m -> Document
d { documentMetadata :: Metadata
documentMetadata = Metadata
m })
{-# INLINE metadata #-}
instance HasMetadata (Tag a) where
metadata :: Optic p f (Tag a) (Tag a) Metadata Metadata
metadata = (Tag a -> Metadata)
-> (Tag a -> Metadata -> Tag a) -> Lens' (Tag a) Metadata
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Tag a -> Metadata
forall a. Tag a -> Metadata
tagMetadata (\d :: Tag a
d m :: Metadata
m -> Tag a
d { tagMetadata :: Metadata
tagMetadata = Metadata
m })
{-# INLINE metadata #-}
instance HasMetadata (Region a) where
metadata :: Optic p f (Region a) (Region a) Metadata Metadata
metadata = (Region a -> Metadata)
-> (Region a -> Metadata -> Region a) -> Lens' (Region a) Metadata
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Region a -> Metadata
forall a. Region a -> Metadata
regionMetadata (\d :: Region a
d m :: Metadata
m -> Region a
d { regionMetadata :: Metadata
regionMetadata = Metadata
m })
{-# INLINE metadata #-}
instance HasMetadata Metadata where
metadata :: Optic p f Metadata Metadata Metadata Metadata
metadata = Optic p f Metadata Metadata Metadata Metadata
forall a. a -> a
id
{-# INLINE metadata #-}
properties :: HasMetadata m => Lens' m (Set Key)
properties :: Lens' m (Set Key)
properties =
Optic p f m m Metadata Metadata
forall t. HasMetadata t => Lens' t Metadata
metadata Optic p f m m Metadata Metadata
-> (p (Set Key) (f (Set Key)) -> p Metadata (f Metadata))
-> p (Set Key) (f (Set Key))
-> p m (f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Metadata -> Set Key)
-> (Metadata -> Set Key -> Metadata)
-> Lens Metadata Metadata (Set Key) (Set Key)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Metadata -> Set Key
metadataProperties (\m :: Metadata
m p :: Set Key
p -> Metadata
m { metadataProperties :: Set Key
metadataProperties = Set Key
p })
{-# INLINABLE properties #-}
{-# SPECIALIZE INLINE properties :: Lens' Metadata (Set Key) #-}
{-# SPECIALIZE INLINE properties :: Lens' Document (Set Key) #-}
{-# SPECIALIZE INLINE properties :: Lens' (Tag a) (Set Key) #-}
{-# SPECIALIZE INLINE properties :: Lens' (Region a) (Set Key) #-}
settings :: HasMetadata m => Lens' m (Assoc Key Text)
settings :: Lens' m (Assoc Key Text)
settings =
Optic p f m m Metadata Metadata
forall t. HasMetadata t => Lens' t Metadata
metadata Optic p f m m Metadata Metadata
-> (p (Assoc Key Text) (f (Assoc Key Text))
-> p Metadata (f Metadata))
-> p (Assoc Key Text) (f (Assoc Key Text))
-> p m (f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Metadata -> Assoc Key Text)
-> (Metadata -> Assoc Key Text -> Metadata)
-> Lens Metadata Metadata (Assoc Key Text) (Assoc Key Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Metadata -> Assoc Key Text
metadataSettings (\m :: Metadata
m s :: Assoc Key Text
s -> Metadata
m { metadataSettings :: Assoc Key Text
metadataSettings = Assoc Key Text
s })
{-# INLINABLE settings #-}
{-# SPECIALIZE INLINE settings :: Lens' Metadata (Assoc Key Text) #-}
{-# SPECIALIZE INLINE settings :: Lens' Document (Assoc Key Text) #-}
{-# SPECIALIZE INLINE settings :: Lens' (Tag a) (Assoc Key Text) #-}
{-# SPECIALIZE INLINE settings :: Lens' (Region a) (Assoc Key Text) #-}
hasProperty :: HasMetadata m => Key -> Lens' m Bool
hasProperty :: Key -> Lens' m Bool
hasProperty k :: Key
k = Optic p f m m (Set Key) (Set Key)
forall m. HasMetadata m => Lens' m (Set Key)
properties Optic p f m m (Set Key) (Set Key)
-> (p Bool (f Bool) -> p (Set Key) (f (Set Key)))
-> p Bool (f Bool)
-> p m (f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic p f (Set Key) (Set Key) (HashSet Key) (HashSet Key)
forall a b. Iso (Set a) (Set b) (HashSet a) (HashSet b)
_Set Optic p f (Set Key) (Set Key) (HashSet Key) (HashSet Key)
-> (p Bool (f Bool) -> p (HashSet Key) (f (HashSet Key)))
-> p Bool (f Bool)
-> p (Set Key) (f (Set Key))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashSet Key -> Bool)
-> (HashSet Key -> Bool -> HashSet Key)
-> Lens (HashSet Key) (HashSet Key) Bool Bool
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(Key -> HashSet Key -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member Key
k)
(\hs :: HashSet Key
hs b :: Bool
b -> (if Bool
b then Key -> HashSet Key -> HashSet Key
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert else Key -> HashSet Key -> HashSet Key
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.delete) Key
k HashSet Key
hs)
{-# INLINE hasProperty #-}
atSetting :: HasMetadata m => Key -> Lens' m (Maybe Text)
atSetting :: Key -> Lens' m (Maybe Text)
atSetting k :: Key
k = Optic p f m m (Assoc Key Text) (Assoc Key Text)
forall m. HasMetadata m => Lens' m (Assoc Key Text)
settings Optic p f m m (Assoc Key Text) (Assoc Key Text)
-> (p (Maybe Text) (f (Maybe Text))
-> p (Assoc Key Text) (f (Assoc Key Text)))
-> p (Maybe Text) (f (Maybe Text))
-> p m (f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Optic
p
f
(Assoc Key Text)
(Assoc Key Text)
(HashMap Key Text)
(HashMap Key Text)
forall k v k' v'.
Iso (Assoc k v) (Assoc k' v') (HashMap k v) (HashMap k' v')
_Assoc Optic
p
f
(Assoc Key Text)
(Assoc Key Text)
(HashMap Key Text)
(HashMap Key Text)
-> (p (Maybe Text) (f (Maybe Text))
-> p (HashMap Key Text) (f (HashMap Key Text)))
-> p (Maybe Text) (f (Maybe Text))
-> p (Assoc Key Text) (f (Assoc Key Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HashMap Key Text -> Maybe Text)
-> (HashMap Key Text -> Maybe Text -> HashMap Key Text)
-> Lens
(HashMap Key Text) (HashMap Key Text) (Maybe Text) (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
(Key -> HashMap Key Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Key
k)
(\hm :: HashMap Key Text
hm x :: Maybe Text
x -> (HashMap Key Text -> HashMap Key Text)
-> (Text -> HashMap Key Text -> HashMap Key Text)
-> Maybe Text
-> HashMap Key Text
-> HashMap Key Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Key -> HashMap Key Text -> HashMap Key Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HM.delete Key
k) (Key -> Text -> HashMap Key Text -> HashMap Key Text
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert Key
k) Maybe Text
x HashMap Key Text
hm)
{-# INLINE atSetting #-}
class HasContent t where
type Content t
content :: Lens' t (Content t)
instance HasContent Document where
type Content Document = Series Block
content :: Optic p f Document Document (Content Document) (Content Document)
content = (Document -> Series Block)
-> (Document -> Series Block -> Document)
-> Lens Document Document (Series Block) (Series Block)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Document -> Series Block
documentContent (\d :: Document
d c :: Series Block
c -> Document
d { documentContent :: Series Block
documentContent = Series Block
c })
{-# INLINE content #-}
instance HasContent (Tag a) where
type Content (Tag a) = a
content :: Optic p f (Tag a) (Tag a) (Content (Tag a)) (Content (Tag a))
content = (Tag a -> a) -> (Tag a -> a -> Tag a) -> Lens (Tag a) (Tag a) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Tag a -> a
forall a. Tag a -> a
tagContent (\t :: Tag a
t c :: a
c -> Tag a
t { tagContent :: a
tagContent = a
c })
{-# INLINE content #-}
instance HasContent (Region a) where
type Content (Region a) = a
content :: Optic
p f (Region a) (Region a) (Content (Region a)) (Content (Region a))
content = (Region a -> a)
-> (Region a -> a -> Region a) -> Lens (Region a) (Region a) a a
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Region a -> a
forall a. Region a -> a
regionContent (\t :: Region a
t c :: a
c -> Region a
t { regionContent :: a
regionContent = a
c })
{-# INLINE content #-}
instance HasContent Paragraph where
type Content Paragraph = SeriesNE Inline
content :: Optic
p f Paragraph Paragraph (Content Paragraph) (Content Paragraph)
content = (Paragraph -> SeriesNE Inline)
-> (Paragraph -> SeriesNE Inline -> Paragraph)
-> Lens Paragraph Paragraph (SeriesNE Inline) (SeriesNE Inline)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Paragraph -> SeriesNE Inline
paragraphContent (\t :: Paragraph
t c :: SeriesNE Inline
c -> Paragraph
t { paragraphContent :: SeriesNE Inline
paragraphContent = SeriesNE Inline
c })
{-# INLINE content #-}
tag :: Lens' (Tag a) Key
tag :: Optic p f (Tag a) (Tag a) Key Key
tag = (Tag a -> Key)
-> (Tag a -> Key -> Tag a) -> Lens (Tag a) (Tag a) Key Key
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Tag a -> Key
forall a. Tag a -> Key
tagName (\t :: Tag a
t n :: Key
n -> Tag a
t { tagName :: Key
tagName = Key
n })
{-# INLINE tag #-}
tagged :: Key -> Prism' (Tag a) (Region a)
tagged :: Key -> Prism' (Tag a) (Region a)
tagged k :: Key
k = (Region a -> Tag a)
-> (Tag a -> Maybe (Region a)) -> Prism' (Tag a) (Region a)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Key -> Region a -> Tag a
forall a. Key -> Region a -> Tag a
regionToTag Key
k)
((Tag a -> Maybe (Region a))
-> Optic p f (Tag a) (Tag a) (Region a) (Region a))
-> (Tag a -> Maybe (Region a))
-> Optic p f (Tag a) (Tag a) (Region a) (Region a)
forall a b. (a -> b) -> a -> b
$ \tag :: Tag a
tag -> if Tag a -> Key
forall a. Tag a -> Key
tagName Tag a
tag Key -> Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key
k then Region a -> Maybe (Region a)
forall a. a -> Maybe a
Just (Region a -> Maybe (Region a)) -> Region a -> Maybe (Region a)
forall a b. (a -> b) -> a -> b
$ Tag a -> Region a
forall a. Tag a -> Region a
tagToRegion Tag a
tag else Maybe (Region a)
forall a. Maybe a
Nothing
{-# INLINE tagged #-}
_BlockTag :: Prism' Block BlockTag
_BlockTag :: Optic p f Block Block BlockTag BlockTag
_BlockTag = (BlockTag -> Block)
-> (Block -> Maybe BlockTag) -> Prism Block Block BlockTag BlockTag
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' BlockTag -> Block
BlockTag ((Block -> Maybe BlockTag)
-> Optic p f Block Block BlockTag BlockTag)
-> (Block -> Maybe BlockTag)
-> Optic p f Block Block BlockTag BlockTag
forall a b. (a -> b) -> a -> b
$ \case
BlockTag t :: BlockTag
t -> BlockTag -> Maybe BlockTag
forall a. a -> Maybe a
Just BlockTag
t
_ -> Maybe BlockTag
forall a. Maybe a
Nothing
_BlockParagraph :: Prism' Block Paragraph
_BlockParagraph :: Optic p f Block Block Paragraph Paragraph
_BlockParagraph = (Paragraph -> Block)
-> (Block -> Maybe Paragraph)
-> Prism Block Block Paragraph Paragraph
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Paragraph -> Block
BlockParagraph ((Block -> Maybe Paragraph)
-> Optic p f Block Block Paragraph Paragraph)
-> (Block -> Maybe Paragraph)
-> Optic p f Block Block Paragraph Paragraph
forall a b. (a -> b) -> a -> b
$ \case
BlockParagraph p :: Paragraph
p -> Paragraph -> Maybe Paragraph
forall a. a -> Maybe a
Just Paragraph
p
_ -> Maybe Paragraph
forall a. Maybe a
Nothing
_BlockLiteral :: Prism' Block LiteralTag
_BlockLiteral :: Optic p f Block Block LiteralTag LiteralTag
_BlockLiteral = (LiteralTag -> Block)
-> (Block -> Maybe LiteralTag)
-> Prism Block Block LiteralTag LiteralTag
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' LiteralTag -> Block
BlockLiteral ((Block -> Maybe LiteralTag)
-> Optic p f Block Block LiteralTag LiteralTag)
-> (Block -> Maybe LiteralTag)
-> Optic p f Block Block LiteralTag LiteralTag
forall a b. (a -> b) -> a -> b
$ \case
BlockLiteral t :: LiteralTag
t -> LiteralTag -> Maybe LiteralTag
forall a. a -> Maybe a
Just LiteralTag
t
_ -> Maybe LiteralTag
forall a. Maybe a
Nothing
_InlineTag :: Prism' Inline InlineTag
_InlineTag :: Optic p f Inline Inline InlineTag InlineTag
_InlineTag = (InlineTag -> Inline)
-> (Inline -> Maybe InlineTag)
-> Prism Inline Inline InlineTag InlineTag
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' InlineTag -> Inline
InlineTag ((Inline -> Maybe InlineTag)
-> Optic p f Inline Inline InlineTag InlineTag)
-> (Inline -> Maybe InlineTag)
-> Optic p f Inline Inline InlineTag InlineTag
forall a b. (a -> b) -> a -> b
$ \case
InlineTag t :: InlineTag
t -> InlineTag -> Maybe InlineTag
forall a. a -> Maybe a
Just InlineTag
t
_ -> Maybe InlineTag
forall a. Maybe a
Nothing
_Text :: Prism' Inline Text
_Text :: Optic p f Inline Inline Text Text
_Text = (Text -> Inline)
-> (Inline -> Maybe Text) -> Prism Inline Inline Text Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Text -> Inline
InlineText ((Inline -> Maybe Text) -> Optic p f Inline Inline Text Text)
-> (Inline -> Maybe Text) -> Optic p f Inline Inline Text Text
forall a b. (a -> b) -> a -> b
$ \case
InlineText t :: Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
_ -> Maybe Text
forall a. Maybe a
Nothing
_Break :: Prism' Inline ()
_Break :: Optic p f Inline Inline () ()
_Break = (() -> Inline) -> (Inline -> Maybe ()) -> Prism Inline Inline () ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Inline -> () -> Inline
forall a b. a -> b -> a
const Inline
Break) ((Inline -> Maybe ()) -> Optic p f Inline Inline () ())
-> (Inline -> Maybe ()) -> Optic p f Inline Inline () ()
forall a b. (a -> b) -> a -> b
$ \case
Break -> () -> Maybe ()
forall a. a -> Maybe a
Just ()
_ -> Maybe ()
forall a. Maybe a
Nothing
key :: Prism' Text Key
key :: Optic p f Text Text Key Key
key = (Key -> Text) -> (Text -> Maybe Key) -> Prism Text Text Key Key
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Key -> Text
rawKey ((KeyError -> Maybe Key)
-> (Key -> Maybe Key) -> Either KeyError Key -> Maybe Key
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Key -> KeyError -> Maybe Key
forall a b. a -> b -> a
const Maybe Key
forall a. Maybe a
Nothing) Key -> Maybe Key
forall a. a -> Maybe a
Just (Either KeyError Key -> Maybe Key)
-> (Text -> Either KeyError Key) -> Text -> Maybe Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either KeyError Key
makeKey)
{-# INLINE key #-}
_Assoc :: Iso (Assoc k v) (Assoc k' v') (HashMap k v) (HashMap k' v')
_Assoc :: Optic p f (Assoc k v) (Assoc k' v') (HashMap k v) (HashMap k' v')
_Assoc = (Assoc k v -> HashMap k v)
-> (HashMap k' v' -> Assoc k' v')
-> Iso (Assoc k v) (Assoc k' v') (HashMap k v) (HashMap k' v')
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Assoc k v -> HashMap k v
forall k v. Assoc k v -> HashMap k v
toHashMap HashMap k' v' -> Assoc k' v'
forall k v. HashMap k v -> Assoc k v
fromHashMap
{-# INLINE _Assoc #-}
_NonEmpty :: Prism' (Series a) (SeriesNE a)
_NonEmpty :: Optic p f (Series a) (Series a) (SeriesNE a) (SeriesNE a)
_NonEmpty = (SeriesNE a -> Series a)
-> (Series a -> Maybe (SeriesNE a))
-> Prism (Series a) (Series a) (SeriesNE a) (SeriesNE a)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Seq a -> Series a
forall a. Seq a -> Series a
fromSeq (Seq a -> Series a)
-> (SeriesNE a -> Seq a) -> SeriesNE a -> Series a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SeriesNE a -> Seq a
forall a. SeriesNE a -> Seq a
toSeqNE) (Seq a -> Maybe (SeriesNE a)
forall a. Seq a -> Maybe (SeriesNE a)
fromSeqNE (Seq a -> Maybe (SeriesNE a))
-> (Series a -> Seq a) -> Series a -> Maybe (SeriesNE a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Series a -> Seq a
forall a. Series a -> Seq a
toSeq)
{-# INLINE _NonEmpty #-}
_Series :: Iso (Series a) (Series b) (Seq a) (Seq b)
_Series :: Optic p f (Series a) (Series b) (Seq a) (Seq b)
_Series = (Series a -> Seq a)
-> (Seq b -> Series b) -> Iso (Series a) (Series b) (Seq a) (Seq b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Series a -> Seq a
forall a. Series a -> Seq a
toSeq Seq b -> Series b
forall a. Seq a -> Series a
fromSeq
{-# INLINE _Series #-}
_SeriesNE :: Prism' (Seq a) (SeriesNE a)
_SeriesNE :: Optic p f (Seq a) (Seq a) (SeriesNE a) (SeriesNE a)
_SeriesNE = (SeriesNE a -> Seq a)
-> (Seq a -> Maybe (SeriesNE a))
-> Prism (Seq a) (Seq a) (SeriesNE a) (SeriesNE a)
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' SeriesNE a -> Seq a
forall a. SeriesNE a -> Seq a
toSeqNE Seq a -> Maybe (SeriesNE a)
forall a. Seq a -> Maybe (SeriesNE a)
fromSeqNE
{-# INLINE _SeriesNE #-}
_Set :: Iso (Set a) (Set b) (HashSet a) (HashSet b)
_Set :: Optic p f (Set a) (Set b) (HashSet a) (HashSet b)
_Set = (Set a -> HashSet a)
-> (HashSet b -> Set b)
-> Iso (Set a) (Set b) (HashSet a) (HashSet b)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Set a -> HashSet a
forall a. Set a -> HashSet a
toHashSet HashSet b -> Set b
forall a. HashSet a -> Set a
fromHashSet
{-# INLINE _Set #-}