Browse Source

Finish up documentation, remove the alpha tag

chris-martin-patch-1
Alex Feldman-Crough 1 year ago
parent
commit
2f5bb1c603
  1. 2
      prosidy.cabal
  2. 31
      src/Prosidy/Optics/Types.hs
  3. 22
      src/Prosidy/Types.hs
  4. 14
      src/Prosidy/Types/Assoc.hs
  5. 16
      src/Prosidy/Types/Series.hs
  6. 11
      src/Prosidy/Types/Set.hs

2
prosidy.cabal

@ -1,6 +1,6 @@
cabal-version: 2.4
name: prosidy
version: 1.5.0.0-rc1
version: 1.5.0.0
synopsis: A simple language for writing documents.
license: MPL-2.0
license-file: LICENSE

31
src/Prosidy/Optics/Types.hs

@ -18,6 +18,8 @@ module Prosidy.Optics.Types
, atSetting
-- ** Items wrapping content
, HasContent(..)
-- * Conversion between 'Tag's and 'Region's.
, tagged
-- * Prisms on 'Block' contexts
, _BlockTag
, _BlockLiteral
@ -50,6 +52,8 @@ import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
-------------------------------------------------------------------------------
-- | A classy optic for focusing on items with 'Metadata', including 'Tag's,
-- 'Region's, and 'Document's.
class HasMetadata t where
metadata :: Lens' t Metadata
@ -69,6 +73,7 @@ instance HasMetadata Metadata where
metadata = id
{-# INLINE metadata #-}
-- | Fetch all properties from items which contain metadata.
properties :: HasMetadata m => Lens' m (Set Key)
properties = metadata . lens metadataProperties (\m p -> m{metadataProperties = p})
{-# INLINEABLE properties #-}
@ -77,6 +82,7 @@ properties = metadata . lens metadataProperties (\m p -> m{metadataProperties =
{-# SPECIALIZE INLINE properties :: Lens' (Tag a) (Set Key) #-}
{-# SPECIALIZE INLINE properties :: Lens' (Region a) (Set Key) #-}
-- | Fetch all settings defined on items which contain metadata.
settings :: HasMetadata m => Lens' m (Assoc Key Text)
settings = metadata . lens metadataSettings (\m s -> m{metadataSettings = s})
{-# INLINABLE settings #-}
@ -85,18 +91,27 @@ settings = metadata . lens metadataSettings (\m s -> m{metadataSettings = s})
{-# SPECIALIZE INLINE settings :: Lens' (Tag a) (Assoc Key Text) #-}
{-# SPECIALIZE INLINE settings :: Lens' (Region a) (Assoc Key Text) #-}
-- | Check if a property is attached to an item with metadata. Using this
-- optic as a setter will add a property if set to 'True' and remove the
-- property when set to 'False'.
hasProperty :: HasMetadata m => Key -> Lens' m Bool
hasProperty k = properties . _Set . lens (HS.member k)
(\hs b -> (if b then HS.insert else HS.delete) k hs)
{-# INLINE hasProperty #-}
-- | Select a setting from an item attached to metadata. Returns 'Nothing' if
-- no value is set.
atSetting :: HasMetadata m => Key -> Lens' m (Maybe Text)
atSetting k = settings . _Assoc . lens (HM.lookup k)
(\hm x -> maybe (HM.delete k) (HM.insert k) x hm)
{-# INLINE atSetting #-}
-------------------------------------------------------------------------------
-- | An optic for selecting children of an item in a recursive structure.
class HasContent t where
-- | The type of /all/ of the children collectively. For instance,
-- @type Content Document = Series Block@, as 'Document' has zero or more
-- contained 'Block's.
type Content t
content :: Lens' t (Content t)
@ -121,31 +136,47 @@ instance HasContent Paragraph where
{-# INLINE content #-}
-------------------------------------------------------------------------------
-- | 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.
tagged :: Key -> Prism' (Tag a) (Region a)
tagged k = prism' (regionToTag k) $ \tag ->
if tagName tag == k
then Just $ tagToRegion tag
else Nothing
{-# INLINE tagged #-}
-------------------------------------------------------------------------------
-- | Focus only on block tags.
_BlockTag :: Prism' Block BlockTag
_BlockTag = prism' BlockTag $ \case
BlockTag t -> Just t
_ -> Nothing
-- | Focus only on paragraphs'
_BlockParagraph :: Prism' Block Paragraph
_BlockParagraph = prism' BlockParagraph $ \case
BlockParagraph p -> Just p
_ -> Nothing
-- | Focus only on literal tags.
_BlockLiteral :: Prism' Block LiteralTag
_BlockLiteral = prism' BlockLiteral $ \case
BlockLiteral t -> Just t
_ -> Nothing
-- | Focus only on inline tags.
_InlineTag :: Prism' Inline InlineTag
_InlineTag = prism' InlineTag $ \case
InlineTag t -> Just t
_ -> Nothing
-- | Focus only on text nodes.
_Text :: Prism' Inline Text
_Text = prism' InlineText $ \case
InlineText t -> Just t
_ -> Nothing
-- | Focus only on breaks.
_Break :: Prism' Inline ()
_Break = prism' (const Break) $ \case
Break -> Just ()

22
src/Prosidy/Types.hs

@ -138,9 +138,13 @@ instance ToJSON Document where
, "content" .= ct
]
-- | Convert a 'Document' to a 'Region'. The resulting 'Region' will never have
-- a 'Location' attached.
documentToRegion :: Document -> Region (Series Block)
documentToRegion (Document md ct) = Region md ct Nothing
-- | Convert a 'Region' to a 'Document'. Any 'Location' on the 'Region' will be
-- discarded.
regionToDocument :: Region (Series Block) -> Document
regionToDocument (Region md ct _) = Document md ct
@ -148,8 +152,16 @@ regionToDocument (Region md ct _) = Document md ct
-- | A sum type enumerating allowed types inside of an inline context.
data Inline =
Break
-- ^ Spacing recorded between lines or on either side of an 'Inline' 'Tag'.
-- Although we could represent this as 'Text', Prosidy defines a special
-- node for this case so that authors in CJK languages (or other languages
-- without explicit spaces between words) may simply ignore these spaces
-- in their output.
| InlineTag InlineTag
-- ^ A 'Tag' which contains only 'Inline' items. These tags begin with the
-- @#@ sigil in source.
| InlineText Text
-- ^ A fragment of plain text.
deriving stock (Eq, Show, Generic)
deriving anyclass (Hashable, Binary, NFData)
@ -295,12 +307,22 @@ instance ToJSON a => ToJSON (Tag a) where
, "content" .= ct
]
-- | A 'Tag' containing zero or more 'Block' items.
-- Specified in Prosidy source with the @#-@ sigil.
type BlockTag = Tag (Series Block)
-- | A 'Tag' containing zero or more 'Inline' items.
-- Specified in Prosidy source with the @#@ sigil.
type InlineTag = Tag (Series Inline)
-- | A 'Tag' containing a single plain-text item.
-- Specified in Prosidy source with the @#=@ sigil.
type LiteralTag = Tag Text
-- | Convert a 'Tag' to a 'Region' by discarding the tag's name.
tagToRegion :: Tag a -> Region a
tagToRegion (Tag _ md ct loc) = Region md ct loc
-- | Convert a 'Region' to a 'Tag' by providing a tag name.
regionToTag :: Key -> Region a -> Tag a
regionToTag name (Region md ct loc) = Tag name md ct loc

14
src/Prosidy/Types/Assoc.hs

@ -24,6 +24,12 @@ import Data.Hashable (Hashable(..))
import qualified Data.HashMap.Strict as HM
-- | An associative mapping of keys to values.
--
-- Currently implemented as a 'HashMap', this newtype wrapper allows us to:
--
-- 1) Add non-orphan instances to the underlying structure.
-- 2) Change the underlying type if needed.
newtype Assoc k v = Assoc (HashMap k v)
deriving stock (Generic)
deriving newtype (Eq, Foldable, Functor, Show, ToJSON, FromJSON, NFData, Semigroup, Monoid, Hashable)
@ -35,11 +41,15 @@ instance (Eq k, Hashable k, Binary k, Binary v) => Binary (Assoc k v) where
put (Assoc hm) =
put $ HM.toList hm
asHashMap :: (HashMap k v -> HashMap k' v') -> Assoc k v -> Assoc k' v'
asHashMap f (Assoc a) = Assoc (f a)
-- | Given a function which operates on a 'HashMap', return a function which
-- performs an equivalent transfromation on an 'Assoc'.
asHashMap :: Functor f => (HashMap k v -> f (HashMap k' v')) -> Assoc k v -> f (Assoc k' v')
asHashMap f (Assoc a) = Assoc <$> f a
-- | Convert a 'HashMap' to an 'Assoc'.
fromHashMap :: HashMap k v -> Assoc k v
fromHashMap = Assoc
-- | Convert an 'Assoc' to a 'HashMap'.
toHashMap :: Assoc k v -> HashMap k v
toHashMap (Assoc hm) = hm

16
src/Prosidy/Types/Series.hs

@ -31,6 +31,10 @@ import Control.Monad (guard)
import qualified Data.Sequence as Seq
-- | A newtype wrapper around a sequential collection.
--
-- Currently, 'Series' is implemented as a 'Seq', but this is not guarenteed to
-- be true.
newtype Series a = Series (Seq a)
deriving stock (Generic, Show)
deriving newtype (Eq, Foldable, Functor, Applicative, ToJSON, FromJSON, NFData, Semigroup, Monoid)
@ -49,6 +53,7 @@ instance Hashable a => Hashable (Series a) where
instance Traversable Series where
traverse f (Series xs) = Series <$> traverse f xs
-- | A non-empty 'Series'.
newtype SeriesNE a = SeriesNE (Seq a)
deriving stock (Generic, Show)
deriving newtype (Eq, Foldable, Functor, Applicative, ToJSON, NFData, Semigroup, Monoid)
@ -73,18 +78,25 @@ instance Hashable a => Hashable (SeriesNE a) where
instance Traversable SeriesNE where
traverse f (SeriesNE xs) = SeriesNE <$> traverse f xs
asSeq :: (Seq a -> Seq b) -> Series a -> Series b
asSeq f (Series s) = Series (f s)
-- | Given a function which operates on a 'Seq', return a function which
-- operates on a 'Series'.
asSeq :: Functor f => (Seq a -> f (Seq b)) -> Series a -> f (Series b)
asSeq f (Series s) = Series <$> f s
-- | Convert a 'Seq' into a 'Series'.
fromSeq :: Seq a -> Series a
fromSeq = Series
-- | Convert a 'Series' into a 'Seq'.
toSeq :: Series a -> Seq a
toSeq (Series s) = s
-- | Convert a non-empty 'Seq' into a 'SeriesNE'.
fromSeqNE :: Seq a -> Maybe (SeriesNE a)
fromSeqNE s | null s = Nothing
fromSeqNE s | otherwise = Just (SeriesNE s)
-- | Convert a 'SeriesNE' into a 'Seq'. The returned 'Seq' is guarenteed to
-- always contain at least one element.
toSeqNE :: SeriesNE a -> Seq a
toSeqNE (SeriesNE a) = a

11
src/Prosidy/Types/Set.hs

@ -26,6 +26,9 @@ import Data.Hashable (Hashable(..))
import qualified Data.HashSet as HS
import qualified Data.HashMap.Strict as HM
-- | A newtype wrapper around an unordered collection of unique elements.
--
-- Currently, this is implemented as a wrapper around a 'HashSet'.
newtype Set a = Set (HashSet a)
deriving stock (Generic)
deriving newtype (Eq, Foldable, Show, NFData, Semigroup, Monoid, Hashable)
@ -46,11 +49,15 @@ instance (Eq a, Hashable a, Binary a) => Binary (Set a) where
put (Set s) =
put $ HS.toList s
asHashSet :: (HashSet a -> HashSet b) -> Set a -> Set b
asHashSet f (Set s) = Set (f s)
-- | Given a function which operates on 'HashSet's, return a function which
-- performs the same operation on a 'Set'.
asHashSet :: Functor f => (HashSet a -> f (HashSet b)) -> Set a -> f (Set b)
asHashSet f (Set s) = Set <$> f s
-- | Convert a 'Set' to a 'HashSet'.
toHashSet :: Set a -> HashSet a
toHashSet (Set s) = s
-- | Convert a 'HashSet' to a 'Set'.
fromHashSet :: HashSet a -> Set a
fromHashSet = Set
Loading…
Cancel
Save