{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Simple Markdown AST and related utilities.
--
-- Parameterising 'Document' with the type of
-- inline code and code blocks allows us to
-- inspect and validate Swarm code in descriptions.
--
-- See 'Swarm.TUI.View.Util.drawMarkdown' for
-- rendering the descriptions as brick widgets.
module Swarm.Language.Text.Markdown (
  -- ** Markdown document
  Document (..),
  Paragraph (..),
  Node (..),
  TxtAttr (..),
  fromTextM,
  fromText,
  docToText,
  docToMark,

  -- ** Token stream
  StreamNode' (..),
  StreamNode,
  ToStream (..),
  toText,

  -- ** Utilities
  findCode,
  chunksOf,
) where

import Commonmark qualified as Mark
import Commonmark.Extensions qualified as Mark (rawAttributeSpec)
import Control.Applicative ((<|>))
import Control.Arrow (left)
import Control.Lens ((%~), (&), _head, _last)
import Data.Char (isSpace)
import Data.Functor.Identity (Identity (..))
import Data.List.Split (chop)
import Data.Maybe (mapMaybe)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as T
import Data.Tuple.Extra (both, first)
import Data.Vector (toList)
import Data.Yaml
import GHC.Exts qualified (IsList (..), IsString (..))
import Swarm.Language.Parser (readTerm)
import Swarm.Language.Pipeline (processParsedTerm)
import Swarm.Language.Syntax (Syntax)
import Swarm.Language.Typecheck (prettyTypeErrText)
import Swarm.Pretty (PrettyPrec (..), prettyText, prettyTextLine)

-- | The top-level markdown document.
newtype Document c = Document {forall c. Document c -> [Paragraph c]
paragraphs :: [Paragraph c]}
  deriving (Document c -> Document c -> Bool
(Document c -> Document c -> Bool)
-> (Document c -> Document c -> Bool) -> Eq (Document c)
forall c. Eq c => Document c -> Document c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => Document c -> Document c -> Bool
== :: Document c -> Document c -> Bool
$c/= :: forall c. Eq c => Document c -> Document c -> Bool
/= :: Document c -> Document c -> Bool
Eq, Int -> Document c -> ShowS
[Document c] -> ShowS
Document c -> String
(Int -> Document c -> ShowS)
-> (Document c -> String)
-> ([Document c] -> ShowS)
-> Show (Document c)
forall c. Show c => Int -> Document c -> ShowS
forall c. Show c => [Document c] -> ShowS
forall c. Show c => Document c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> Document c -> ShowS
showsPrec :: Int -> Document c -> ShowS
$cshow :: forall c. Show c => Document c -> String
show :: Document c -> String
$cshowList :: forall c. Show c => [Document c] -> ShowS
showList :: [Document c] -> ShowS
Show, (forall a b. (a -> b) -> Document a -> Document b)
-> (forall a b. a -> Document b -> Document a) -> Functor Document
forall a b. a -> Document b -> Document a
forall a b. (a -> b) -> Document a -> Document b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Document a -> Document b
fmap :: forall a b. (a -> b) -> Document a -> Document b
$c<$ :: forall a b. a -> Document b -> Document a
<$ :: forall a b. a -> Document b -> Document a
Functor, (forall m. Monoid m => Document m -> m)
-> (forall m a. Monoid m => (a -> m) -> Document a -> m)
-> (forall m a. Monoid m => (a -> m) -> Document a -> m)
-> (forall a b. (a -> b -> b) -> b -> Document a -> b)
-> (forall a b. (a -> b -> b) -> b -> Document a -> b)
-> (forall b a. (b -> a -> b) -> b -> Document a -> b)
-> (forall b a. (b -> a -> b) -> b -> Document a -> b)
-> (forall a. (a -> a -> a) -> Document a -> a)
-> (forall a. (a -> a -> a) -> Document a -> a)
-> (forall a. Document a -> [a])
-> (forall a. Document a -> Bool)
-> (forall a. Document a -> Int)
-> (forall a. Eq a => a -> Document a -> Bool)
-> (forall a. Ord a => Document a -> a)
-> (forall a. Ord a => Document a -> a)
-> (forall a. Num a => Document a -> a)
-> (forall a. Num a => Document a -> a)
-> Foldable Document
forall a. Eq a => a -> Document a -> Bool
forall a. Num a => Document a -> a
forall a. Ord a => Document a -> a
forall m. Monoid m => Document m -> m
forall a. Document a -> Bool
forall a. Document a -> Int
forall a. Document a -> [a]
forall a. (a -> a -> a) -> Document a -> a
forall m a. Monoid m => (a -> m) -> Document a -> m
forall b a. (b -> a -> b) -> b -> Document a -> b
forall a b. (a -> b -> b) -> b -> Document a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Document m -> m
fold :: forall m. Monoid m => Document m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Document a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Document a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Document a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Document a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Document a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Document a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Document a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Document a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Document a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Document a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Document a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Document a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Document a -> a
foldr1 :: forall a. (a -> a -> a) -> Document a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Document a -> a
foldl1 :: forall a. (a -> a -> a) -> Document a -> a
$ctoList :: forall a. Document a -> [a]
toList :: forall a. Document a -> [a]
$cnull :: forall a. Document a -> Bool
null :: forall a. Document a -> Bool
$clength :: forall a. Document a -> Int
length :: forall a. Document a -> Int
$celem :: forall a. Eq a => a -> Document a -> Bool
elem :: forall a. Eq a => a -> Document a -> Bool
$cmaximum :: forall a. Ord a => Document a -> a
maximum :: forall a. Ord a => Document a -> a
$cminimum :: forall a. Ord a => Document a -> a
minimum :: forall a. Ord a => Document a -> a
$csum :: forall a. Num a => Document a -> a
sum :: forall a. Num a => Document a -> a
$cproduct :: forall a. Num a => Document a -> a
product :: forall a. Num a => Document a -> a
Foldable, Functor Document
Foldable Document
(Functor Document, Foldable Document) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Document a -> f (Document b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Document (f a) -> f (Document a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Document a -> m (Document b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Document (m a) -> m (Document a))
-> Traversable Document
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Document (m a) -> m (Document a)
forall (f :: * -> *) a.
Applicative f =>
Document (f a) -> f (Document a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Document a -> m (Document b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Document a -> f (Document b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Document a -> f (Document b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Document a -> f (Document b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Document (f a) -> f (Document a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Document (f a) -> f (Document a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Document a -> m (Document b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Document a -> m (Document b)
$csequence :: forall (m :: * -> *) a. Monad m => Document (m a) -> m (Document a)
sequence :: forall (m :: * -> *) a. Monad m => Document (m a) -> m (Document a)
Traversable)
  deriving (NonEmpty (Document c) -> Document c
Document c -> Document c -> Document c
(Document c -> Document c -> Document c)
-> (NonEmpty (Document c) -> Document c)
-> (forall b. Integral b => b -> Document c -> Document c)
-> Semigroup (Document c)
forall b. Integral b => b -> Document c -> Document c
forall c. NonEmpty (Document c) -> Document c
forall c. Document c -> Document c -> Document c
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall c b. Integral b => b -> Document c -> Document c
$c<> :: forall c. Document c -> Document c -> Document c
<> :: Document c -> Document c -> Document c
$csconcat :: forall c. NonEmpty (Document c) -> Document c
sconcat :: NonEmpty (Document c) -> Document c
$cstimes :: forall c b. Integral b => b -> Document c -> Document c
stimes :: forall b. Integral b => b -> Document c -> Document c
Semigroup, Semigroup (Document c)
Document c
Semigroup (Document c) =>
Document c
-> (Document c -> Document c -> Document c)
-> ([Document c] -> Document c)
-> Monoid (Document c)
[Document c] -> Document c
Document c -> Document c -> Document c
forall c. Semigroup (Document c)
forall c. Document c
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall c. [Document c] -> Document c
forall c. Document c -> Document c -> Document c
$cmempty :: forall c. Document c
mempty :: Document c
$cmappend :: forall c. Document c -> Document c -> Document c
mappend :: Document c -> Document c -> Document c
$cmconcat :: forall c. [Document c] -> Document c
mconcat :: [Document c] -> Document c
Monoid) via [Paragraph c]

-- | Markdown paragraphs that contain inline leaf nodes.
--
-- The idea is that paragraphs do not have line breaks,
-- and so the inline elements follow each other.
-- In particular inline code can be followed by text without
-- space between them (e.g. @\`logger\`s@).
newtype Paragraph c = Paragraph {forall c. Paragraph c -> [Node c]
nodes :: [Node c]}
  deriving (Paragraph c -> Paragraph c -> Bool
(Paragraph c -> Paragraph c -> Bool)
-> (Paragraph c -> Paragraph c -> Bool) -> Eq (Paragraph c)
forall c. Eq c => Paragraph c -> Paragraph c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => Paragraph c -> Paragraph c -> Bool
== :: Paragraph c -> Paragraph c -> Bool
$c/= :: forall c. Eq c => Paragraph c -> Paragraph c -> Bool
/= :: Paragraph c -> Paragraph c -> Bool
Eq, Int -> Paragraph c -> ShowS
[Paragraph c] -> ShowS
Paragraph c -> String
(Int -> Paragraph c -> ShowS)
-> (Paragraph c -> String)
-> ([Paragraph c] -> ShowS)
-> Show (Paragraph c)
forall c. Show c => Int -> Paragraph c -> ShowS
forall c. Show c => [Paragraph c] -> ShowS
forall c. Show c => Paragraph c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> Paragraph c -> ShowS
showsPrec :: Int -> Paragraph c -> ShowS
$cshow :: forall c. Show c => Paragraph c -> String
show :: Paragraph c -> String
$cshowList :: forall c. Show c => [Paragraph c] -> ShowS
showList :: [Paragraph c] -> ShowS
Show, (forall a b. (a -> b) -> Paragraph a -> Paragraph b)
-> (forall a b. a -> Paragraph b -> Paragraph a)
-> Functor Paragraph
forall a b. a -> Paragraph b -> Paragraph a
forall a b. (a -> b) -> Paragraph a -> Paragraph b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Paragraph a -> Paragraph b
fmap :: forall a b. (a -> b) -> Paragraph a -> Paragraph b
$c<$ :: forall a b. a -> Paragraph b -> Paragraph a
<$ :: forall a b. a -> Paragraph b -> Paragraph a
Functor, (forall m. Monoid m => Paragraph m -> m)
-> (forall m a. Monoid m => (a -> m) -> Paragraph a -> m)
-> (forall m a. Monoid m => (a -> m) -> Paragraph a -> m)
-> (forall a b. (a -> b -> b) -> b -> Paragraph a -> b)
-> (forall a b. (a -> b -> b) -> b -> Paragraph a -> b)
-> (forall b a. (b -> a -> b) -> b -> Paragraph a -> b)
-> (forall b a. (b -> a -> b) -> b -> Paragraph a -> b)
-> (forall a. (a -> a -> a) -> Paragraph a -> a)
-> (forall a. (a -> a -> a) -> Paragraph a -> a)
-> (forall a. Paragraph a -> [a])
-> (forall a. Paragraph a -> Bool)
-> (forall a. Paragraph a -> Int)
-> (forall a. Eq a => a -> Paragraph a -> Bool)
-> (forall a. Ord a => Paragraph a -> a)
-> (forall a. Ord a => Paragraph a -> a)
-> (forall a. Num a => Paragraph a -> a)
-> (forall a. Num a => Paragraph a -> a)
-> Foldable Paragraph
forall a. Eq a => a -> Paragraph a -> Bool
forall a. Num a => Paragraph a -> a
forall a. Ord a => Paragraph a -> a
forall m. Monoid m => Paragraph m -> m
forall a. Paragraph a -> Bool
forall a. Paragraph a -> Int
forall a. Paragraph a -> [a]
forall a. (a -> a -> a) -> Paragraph a -> a
forall m a. Monoid m => (a -> m) -> Paragraph a -> m
forall b a. (b -> a -> b) -> b -> Paragraph a -> b
forall a b. (a -> b -> b) -> b -> Paragraph a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Paragraph m -> m
fold :: forall m. Monoid m => Paragraph m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Paragraph a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Paragraph a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Paragraph a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Paragraph a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Paragraph a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Paragraph a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Paragraph a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Paragraph a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Paragraph a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Paragraph a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Paragraph a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Paragraph a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Paragraph a -> a
foldr1 :: forall a. (a -> a -> a) -> Paragraph a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Paragraph a -> a
foldl1 :: forall a. (a -> a -> a) -> Paragraph a -> a
$ctoList :: forall a. Paragraph a -> [a]
toList :: forall a. Paragraph a -> [a]
$cnull :: forall a. Paragraph a -> Bool
null :: forall a. Paragraph a -> Bool
$clength :: forall a. Paragraph a -> Int
length :: forall a. Paragraph a -> Int
$celem :: forall a. Eq a => a -> Paragraph a -> Bool
elem :: forall a. Eq a => a -> Paragraph a -> Bool
$cmaximum :: forall a. Ord a => Paragraph a -> a
maximum :: forall a. Ord a => Paragraph a -> a
$cminimum :: forall a. Ord a => Paragraph a -> a
minimum :: forall a. Ord a => Paragraph a -> a
$csum :: forall a. Num a => Paragraph a -> a
sum :: forall a. Num a => Paragraph a -> a
$cproduct :: forall a. Num a => Paragraph a -> a
product :: forall a. Num a => Paragraph a -> a
Foldable, Functor Paragraph
Foldable Paragraph
(Functor Paragraph, Foldable Paragraph) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Paragraph a -> f (Paragraph b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Paragraph (f a) -> f (Paragraph a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Paragraph a -> m (Paragraph b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Paragraph (m a) -> m (Paragraph a))
-> Traversable Paragraph
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Paragraph (m a) -> m (Paragraph a)
forall (f :: * -> *) a.
Applicative f =>
Paragraph (f a) -> f (Paragraph a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Paragraph a -> m (Paragraph b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Paragraph a -> f (Paragraph b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Paragraph a -> f (Paragraph b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Paragraph a -> f (Paragraph b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Paragraph (f a) -> f (Paragraph a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Paragraph (f a) -> f (Paragraph a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Paragraph a -> m (Paragraph b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Paragraph a -> m (Paragraph b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
Paragraph (m a) -> m (Paragraph a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Paragraph (m a) -> m (Paragraph a)
Traversable)
  deriving (NonEmpty (Paragraph c) -> Paragraph c
Paragraph c -> Paragraph c -> Paragraph c
(Paragraph c -> Paragraph c -> Paragraph c)
-> (NonEmpty (Paragraph c) -> Paragraph c)
-> (forall b. Integral b => b -> Paragraph c -> Paragraph c)
-> Semigroup (Paragraph c)
forall b. Integral b => b -> Paragraph c -> Paragraph c
forall c. NonEmpty (Paragraph c) -> Paragraph c
forall c. Paragraph c -> Paragraph c -> Paragraph c
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall c b. Integral b => b -> Paragraph c -> Paragraph c
$c<> :: forall c. Paragraph c -> Paragraph c -> Paragraph c
<> :: Paragraph c -> Paragraph c -> Paragraph c
$csconcat :: forall c. NonEmpty (Paragraph c) -> Paragraph c
sconcat :: NonEmpty (Paragraph c) -> Paragraph c
$cstimes :: forall c b. Integral b => b -> Paragraph c -> Paragraph c
stimes :: forall b. Integral b => b -> Paragraph c -> Paragraph c
Semigroup, Semigroup (Paragraph c)
Paragraph c
Semigroup (Paragraph c) =>
Paragraph c
-> (Paragraph c -> Paragraph c -> Paragraph c)
-> ([Paragraph c] -> Paragraph c)
-> Monoid (Paragraph c)
[Paragraph c] -> Paragraph c
Paragraph c -> Paragraph c -> Paragraph c
forall c. Semigroup (Paragraph c)
forall c. Paragraph c
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall c. [Paragraph c] -> Paragraph c
forall c. Paragraph c -> Paragraph c -> Paragraph c
$cmempty :: forall c. Paragraph c
mempty :: Paragraph c
$cmappend :: forall c. Paragraph c -> Paragraph c -> Paragraph c
mappend :: Paragraph c -> Paragraph c -> Paragraph c
$cmconcat :: forall c. [Paragraph c] -> Paragraph c
mconcat :: [Paragraph c] -> Paragraph c
Monoid) via [Node c]

mapP :: (Node c -> Node c) -> Paragraph c -> Paragraph c
mapP :: forall c. (Node c -> Node c) -> Paragraph c -> Paragraph c
mapP Node c -> Node c
f (Paragraph [Node c]
ns) = [Node c] -> Paragraph c
forall c. [Node c] -> Paragraph c
Paragraph ((Node c -> Node c) -> [Node c] -> [Node c]
forall a b. (a -> b) -> [a] -> [b]
map Node c -> Node c
f [Node c]
ns)

pureP :: Node c -> Paragraph c
pureP :: forall c. Node c -> Paragraph c
pureP = [Node c] -> Paragraph c
forall c. [Node c] -> Paragraph c
Paragraph ([Node c] -> Paragraph c)
-> (Node c -> [Node c]) -> Node c -> Paragraph c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node c -> [Node c] -> [Node c]
forall a. a -> [a] -> [a]
: [])

-- | Inline leaf nodes.
--
-- The raw node is from the raw_annotation extension,
-- and can be used for types/entities/invalid code.
data Node c
  = LeafText (Set TxtAttr) Text
  | LeafRaw String Text
  | LeafCode c
  | LeafCodeBlock String c
  deriving (Node c -> Node c -> Bool
(Node c -> Node c -> Bool)
-> (Node c -> Node c -> Bool) -> Eq (Node c)
forall c. Eq c => Node c -> Node c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall c. Eq c => Node c -> Node c -> Bool
== :: Node c -> Node c -> Bool
$c/= :: forall c. Eq c => Node c -> Node c -> Bool
/= :: Node c -> Node c -> Bool
Eq, Int -> Node c -> ShowS
[Node c] -> ShowS
Node c -> String
(Int -> Node c -> ShowS)
-> (Node c -> String) -> ([Node c] -> ShowS) -> Show (Node c)
forall c. Show c => Int -> Node c -> ShowS
forall c. Show c => [Node c] -> ShowS
forall c. Show c => Node c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall c. Show c => Int -> Node c -> ShowS
showsPrec :: Int -> Node c -> ShowS
$cshow :: forall c. Show c => Node c -> String
show :: Node c -> String
$cshowList :: forall c. Show c => [Node c] -> ShowS
showList :: [Node c] -> ShowS
Show, (forall a b. (a -> b) -> Node a -> Node b)
-> (forall a b. a -> Node b -> Node a) -> Functor Node
forall a b. a -> Node b -> Node a
forall a b. (a -> b) -> Node a -> Node b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Node a -> Node b
fmap :: forall a b. (a -> b) -> Node a -> Node b
$c<$ :: forall a b. a -> Node b -> Node a
<$ :: forall a b. a -> Node b -> Node a
Functor, (forall m. Monoid m => Node m -> m)
-> (forall m a. Monoid m => (a -> m) -> Node a -> m)
-> (forall m a. Monoid m => (a -> m) -> Node a -> m)
-> (forall a b. (a -> b -> b) -> b -> Node a -> b)
-> (forall a b. (a -> b -> b) -> b -> Node a -> b)
-> (forall b a. (b -> a -> b) -> b -> Node a -> b)
-> (forall b a. (b -> a -> b) -> b -> Node a -> b)
-> (forall a. (a -> a -> a) -> Node a -> a)
-> (forall a. (a -> a -> a) -> Node a -> a)
-> (forall a. Node a -> [a])
-> (forall a. Node a -> Bool)
-> (forall a. Node a -> Int)
-> (forall a. Eq a => a -> Node a -> Bool)
-> (forall a. Ord a => Node a -> a)
-> (forall a. Ord a => Node a -> a)
-> (forall a. Num a => Node a -> a)
-> (forall a. Num a => Node a -> a)
-> Foldable Node
forall a. Eq a => a -> Node a -> Bool
forall a. Num a => Node a -> a
forall a. Ord a => Node a -> a
forall m. Monoid m => Node m -> m
forall a. Node a -> Bool
forall a. Node a -> Int
forall a. Node a -> [a]
forall a. (a -> a -> a) -> Node a -> a
forall m a. Monoid m => (a -> m) -> Node a -> m
forall b a. (b -> a -> b) -> b -> Node a -> b
forall a b. (a -> b -> b) -> b -> Node a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Node m -> m
fold :: forall m. Monoid m => Node m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Node a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Node a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Node a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Node a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Node a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Node a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Node a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Node a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Node a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Node a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Node a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Node a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Node a -> a
foldr1 :: forall a. (a -> a -> a) -> Node a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Node a -> a
foldl1 :: forall a. (a -> a -> a) -> Node a -> a
$ctoList :: forall a. Node a -> [a]
toList :: forall a. Node a -> [a]
$cnull :: forall a. Node a -> Bool
null :: forall a. Node a -> Bool
$clength :: forall a. Node a -> Int
length :: forall a. Node a -> Int
$celem :: forall a. Eq a => a -> Node a -> Bool
elem :: forall a. Eq a => a -> Node a -> Bool
$cmaximum :: forall a. Ord a => Node a -> a
maximum :: forall a. Ord a => Node a -> a
$cminimum :: forall a. Ord a => Node a -> a
minimum :: forall a. Ord a => Node a -> a
$csum :: forall a. Num a => Node a -> a
sum :: forall a. Num a => Node a -> a
$cproduct :: forall a. Num a => Node a -> a
product :: forall a. Num a => Node a -> a
Foldable, Functor Node
Foldable Node
(Functor Node, Foldable Node) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Node a -> f (Node b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Node (f a) -> f (Node a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Node a -> m (Node b))
-> (forall (m :: * -> *) a. Monad m => Node (m a) -> m (Node a))
-> Traversable Node
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Node (m a) -> m (Node a)
forall (f :: * -> *) a. Applicative f => Node (f a) -> f (Node a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node a -> m (Node b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node a -> f (Node b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node a -> f (Node b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node a -> f (Node b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Node (f a) -> f (Node a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Node (f a) -> f (Node a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node a -> m (Node b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node a -> m (Node b)
$csequence :: forall (m :: * -> *) a. Monad m => Node (m a) -> m (Node a)
sequence :: forall (m :: * -> *) a. Monad m => Node (m a) -> m (Node a)
Traversable)

txt :: Text -> Node c
txt :: forall c. Text -> Node c
txt = Set TxtAttr -> Text -> Node c
forall c. Set TxtAttr -> Text -> Node c
LeafText Set TxtAttr
forall a. Monoid a => a
mempty

addTextAttribute :: TxtAttr -> Node c -> Node c
addTextAttribute :: forall c. TxtAttr -> Node c -> Node c
addTextAttribute TxtAttr
a (LeafText Set TxtAttr
as Text
t) = Set TxtAttr -> Text -> Node c
forall c. Set TxtAttr -> Text -> Node c
LeafText (TxtAttr -> Set TxtAttr -> Set TxtAttr
forall a. Ord a => a -> Set a -> Set a
Set.insert TxtAttr
a Set TxtAttr
as) Text
t
addTextAttribute TxtAttr
_ Node c
n = Node c
n

normalise :: (Eq c, Semigroup c) => Paragraph c -> Paragraph c
normalise :: forall c. (Eq c, Semigroup c) => Paragraph c -> Paragraph c
normalise (Paragraph [Node c]
a) = [Node c] -> Paragraph c
forall c. [Node c] -> Paragraph c
Paragraph ([Node c] -> Paragraph c) -> [Node c] -> Paragraph c
forall a b. (a -> b) -> a -> b
$ [Node c] -> [Node c]
forall {c}. [Node c] -> [Node c]
go [Node c]
a
 where
  go :: [Node c] -> [Node c]
go = \case
    [] -> []
    (Node c
n : [Node c]
ns) -> let (Node c
n', [Node c]
ns') = Node c -> [Node c] -> (Node c, [Node c])
forall {c} {c}. Node c -> [Node c] -> (Node c, [Node c])
mergeSame Node c
n [Node c]
ns in Node c
n' Node c -> [Node c] -> [Node c]
forall a. a -> [a] -> [a]
: [Node c] -> [Node c]
go [Node c]
ns'
  mergeSame :: Node c -> [Node c] -> (Node c, [Node c])
mergeSame = \case
    l :: Node c
l@(LeafText Set TxtAttr
attrs1 Text
t1) -> \case
      (LeafText Set TxtAttr
attrs2 Text
t2 : [Node c]
rss) | Set TxtAttr
attrs1 Set TxtAttr -> Set TxtAttr -> Bool
forall a. Eq a => a -> a -> Bool
== Set TxtAttr
attrs2 -> Node c -> [Node c] -> (Node c, [Node c])
mergeSame (Set TxtAttr -> Text -> Node c
forall c. Set TxtAttr -> Text -> Node c
LeafText Set TxtAttr
attrs1 (Text -> Node c) -> Text -> Node c
forall a b. (a -> b) -> a -> b
$ Text
t1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t2) [Node c]
rss
      [Node c]
rs -> (Node c
l, [Node c]
rs)
    Node c
l -> (Node c
l,)

-- | Simple text attributes that make it easier to find key info in descriptions.
data TxtAttr = Strong | Emphasis
  deriving (TxtAttr -> TxtAttr -> Bool
(TxtAttr -> TxtAttr -> Bool)
-> (TxtAttr -> TxtAttr -> Bool) -> Eq TxtAttr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxtAttr -> TxtAttr -> Bool
== :: TxtAttr -> TxtAttr -> Bool
$c/= :: TxtAttr -> TxtAttr -> Bool
/= :: TxtAttr -> TxtAttr -> Bool
Eq, Int -> TxtAttr -> ShowS
[TxtAttr] -> ShowS
TxtAttr -> String
(Int -> TxtAttr -> ShowS)
-> (TxtAttr -> String) -> ([TxtAttr] -> ShowS) -> Show TxtAttr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxtAttr -> ShowS
showsPrec :: Int -> TxtAttr -> ShowS
$cshow :: TxtAttr -> String
show :: TxtAttr -> String
$cshowList :: [TxtAttr] -> ShowS
showList :: [TxtAttr] -> ShowS
Show, Eq TxtAttr
Eq TxtAttr =>
(TxtAttr -> TxtAttr -> Ordering)
-> (TxtAttr -> TxtAttr -> Bool)
-> (TxtAttr -> TxtAttr -> Bool)
-> (TxtAttr -> TxtAttr -> Bool)
-> (TxtAttr -> TxtAttr -> Bool)
-> (TxtAttr -> TxtAttr -> TxtAttr)
-> (TxtAttr -> TxtAttr -> TxtAttr)
-> Ord TxtAttr
TxtAttr -> TxtAttr -> Bool
TxtAttr -> TxtAttr -> Ordering
TxtAttr -> TxtAttr -> TxtAttr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TxtAttr -> TxtAttr -> Ordering
compare :: TxtAttr -> TxtAttr -> Ordering
$c< :: TxtAttr -> TxtAttr -> Bool
< :: TxtAttr -> TxtAttr -> Bool
$c<= :: TxtAttr -> TxtAttr -> Bool
<= :: TxtAttr -> TxtAttr -> Bool
$c> :: TxtAttr -> TxtAttr -> Bool
> :: TxtAttr -> TxtAttr -> Bool
$c>= :: TxtAttr -> TxtAttr -> Bool
>= :: TxtAttr -> TxtAttr -> Bool
$cmax :: TxtAttr -> TxtAttr -> TxtAttr
max :: TxtAttr -> TxtAttr -> TxtAttr
$cmin :: TxtAttr -> TxtAttr -> TxtAttr
min :: TxtAttr -> TxtAttr -> TxtAttr
Ord)

instance Mark.Rangeable (Paragraph c) where
  ranged :: SourceRange -> Paragraph c -> Paragraph c
ranged SourceRange
_ = Paragraph c -> Paragraph c
forall a. a -> a
id

instance Mark.HasAttributes (Paragraph c) where
  addAttributes :: Attributes -> Paragraph c -> Paragraph c
addAttributes Attributes
_ = Paragraph c -> Paragraph c
forall a. a -> a
id

instance Mark.Rangeable (Document c) where
  ranged :: SourceRange -> Document c -> Document c
ranged SourceRange
_ = Document c -> Document c
forall a. a -> a
id

instance Mark.HasAttributes (Document c) where
  addAttributes :: Attributes -> Document c -> Document c
addAttributes Attributes
_ = Document c -> Document c
forall a. a -> a
id

instance GHC.Exts.IsList (Document a) where
  type Item (Document a) = Paragraph a
  toList :: Document a -> [Item (Document a)]
toList = Document a -> [Item (Document a)]
Document a -> [Paragraph a]
forall c. Document c -> [Paragraph c]
paragraphs
  fromList :: [Item (Document a)] -> Document a
fromList = [Item (Document a)] -> Document a
[Paragraph a] -> Document a
forall c. [Paragraph c] -> Document c
Document

instance GHC.Exts.IsString (Document Syntax) where
  fromString :: String -> Document Syntax
fromString = Text -> Document Syntax
fromText (Text -> Document Syntax)
-> (String -> Text) -> String -> Document Syntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

instance GHC.Exts.IsString (Paragraph Syntax) where
  fromString :: String -> Paragraph Syntax
fromString String
s = case Document Syntax -> [Paragraph Syntax]
forall c. Document c -> [Paragraph c]
paragraphs (Document Syntax -> [Paragraph Syntax])
-> Document Syntax -> [Paragraph Syntax]
forall a b. (a -> b) -> a -> b
$ String -> Document Syntax
forall a. IsString a => String -> a
GHC.Exts.fromString String
s of
    [] -> Paragraph Syntax
forall a. Monoid a => a
mempty
    (Paragraph Syntax
p : [Paragraph Syntax]
_) -> Paragraph Syntax
p

-- | Surround some text in double quotes if it is not empty.
quoteMaybe :: Text -> Text
quoteMaybe :: Text -> Text
quoteMaybe Text
t = if Text -> Bool
T.null Text
t then Text
t else [Text] -> Text
T.concat [Text
"\"", Text
t, Text
"\""]

instance Mark.IsInline (Paragraph Text) where
  lineBreak :: Paragraph Text
lineBreak = Node Text -> Paragraph Text
forall c. Node c -> Paragraph c
pureP (Node Text -> Paragraph Text) -> Node Text -> Paragraph Text
forall a b. (a -> b) -> a -> b
$ Text -> Node Text
forall c. Text -> Node c
txt Text
"\n"
  softBreak :: Paragraph Text
softBreak = Node Text -> Paragraph Text
forall c. Node c -> Paragraph c
pureP (Node Text -> Paragraph Text) -> Node Text -> Paragraph Text
forall a b. (a -> b) -> a -> b
$ Text -> Node Text
forall c. Text -> Node c
txt Text
" "
  str :: Text -> Paragraph Text
str = Node Text -> Paragraph Text
forall c. Node c -> Paragraph c
pureP (Node Text -> Paragraph Text)
-> (Text -> Node Text) -> Text -> Paragraph Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node Text
forall c. Text -> Node c
txt
  entity :: Text -> Paragraph Text
entity = Text -> Paragraph Text
forall a. IsInline a => Text -> a
Mark.str
  escapedChar :: Char -> Paragraph Text
escapedChar Char
c = Text -> Paragraph Text
forall a. IsInline a => Text -> a
Mark.str (Text -> Paragraph Text) -> Text -> Paragraph Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack [Char
'\\', Char
c]
  emph :: Paragraph Text -> Paragraph Text
emph = (Node Text -> Node Text) -> Paragraph Text -> Paragraph Text
forall c. (Node c -> Node c) -> Paragraph c -> Paragraph c
mapP ((Node Text -> Node Text) -> Paragraph Text -> Paragraph Text)
-> (Node Text -> Node Text) -> Paragraph Text -> Paragraph Text
forall a b. (a -> b) -> a -> b
$ TxtAttr -> Node Text -> Node Text
forall c. TxtAttr -> Node c -> Node c
addTextAttribute TxtAttr
Emphasis
  strong :: Paragraph Text -> Paragraph Text
strong = (Node Text -> Node Text) -> Paragraph Text -> Paragraph Text
forall c. (Node c -> Node c) -> Paragraph c -> Paragraph c
mapP ((Node Text -> Node Text) -> Paragraph Text -> Paragraph Text)
-> (Node Text -> Node Text) -> Paragraph Text -> Paragraph Text
forall a b. (a -> b) -> a -> b
$ TxtAttr -> Node Text -> Node Text
forall c. TxtAttr -> Node c -> Node c
addTextAttribute TxtAttr
Strong
  link :: Text -> Text -> Paragraph Text -> Paragraph Text
link Text
dest Text
title Paragraph Text
desc = Node Text -> Paragraph Text
forall c. Node c -> Paragraph c
pureP (Text -> Node Text
forall c. Text -> Node c
txt Text
"[") Paragraph Text -> Paragraph Text -> Paragraph Text
forall a. Semigroup a => a -> a -> a
<> Paragraph Text
desc Paragraph Text -> Paragraph Text -> Paragraph Text
forall a. Semigroup a => a -> a -> a
<> Node Text -> Paragraph Text
forall c. Node c -> Paragraph c
pureP (Text -> Node Text
forall c. Text -> Node c
txt (Text -> Node Text) -> Text -> Node Text
forall a b. (a -> b) -> a -> b
$ Text
"](" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
dest Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteMaybe Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")")
  image :: Text -> Text -> Paragraph Text -> Paragraph Text
image Text
dest Text
title Paragraph Text
desc = Node Text -> Paragraph Text
forall c. Node c -> Paragraph c
pureP (Text -> Node Text
forall c. Text -> Node c
txt Text
"!") Paragraph Text -> Paragraph Text -> Paragraph Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text -> Paragraph Text -> Paragraph Text
forall a. IsInline a => Text -> Text -> a -> a
Mark.link Text
dest Text
title Paragraph Text
desc
  code :: Text -> Paragraph Text
code = Node Text -> Paragraph Text
forall c. Node c -> Paragraph c
pureP (Node Text -> Paragraph Text)
-> (Text -> Node Text) -> Text -> Paragraph Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Node Text
forall c. c -> Node c
LeafCode
  rawInline :: Format -> Text -> Paragraph Text
rawInline (Mark.Format Text
f) = Node Text -> Paragraph Text
forall c. Node c -> Paragraph c
pureP (Node Text -> Paragraph Text)
-> (Text -> Node Text) -> Text -> Paragraph Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Node Text
forall c. String -> Text -> Node c
LeafRaw (Text -> String
T.unpack Text
f)

instance Mark.IsBlock (Paragraph Text) (Document Text) where
  paragraph :: Paragraph Text -> Document Text
paragraph = [Paragraph Text] -> Document Text
forall c. [Paragraph c] -> Document c
Document ([Paragraph Text] -> Document Text)
-> (Paragraph Text -> [Paragraph Text])
-> Paragraph Text
-> Document Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Paragraph Text -> [Paragraph Text] -> [Paragraph Text]
forall a. a -> [a] -> [a]
: [])
  plain :: Paragraph Text -> Document Text
plain = Paragraph Text -> Document Text
forall il b. IsBlock il b => il -> b
Mark.paragraph
  thematicBreak :: Document Text
thematicBreak = Document Text
forall a. Monoid a => a
mempty
  blockQuote :: Document Text -> Document Text
blockQuote (Document [Paragraph Text]
ns) = [Paragraph Text] -> Document Text
forall c. [Paragraph c] -> Document c
Document ([Paragraph Text] -> Document Text)
-> [Paragraph Text] -> Document Text
forall a b. (a -> b) -> a -> b
$ (Paragraph Text -> Paragraph Text)
-> [Paragraph Text] -> [Paragraph Text]
forall a b. (a -> b) -> [a] -> [b]
map Paragraph Text -> Paragraph Text
forall a. IsInline a => a -> a
Mark.emph [Paragraph Text]
ns
  codeBlock :: Text -> Text -> Document Text
codeBlock Text
f = Paragraph Text -> Document Text
forall il b. IsBlock il b => il -> b
Mark.plain (Paragraph Text -> Document Text)
-> (Text -> Paragraph Text) -> Text -> Document Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node Text -> Paragraph Text
forall c. Node c -> Paragraph c
pureP (Node Text -> Paragraph Text)
-> (Text -> Node Text) -> Text -> Paragraph Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text -> Node Text
forall c. String -> c -> Node c
LeafCodeBlock (Text -> String
T.unpack Text
f)
  heading :: Int -> Paragraph Text -> Document Text
heading Int
_lvl = Paragraph Text -> Document Text
forall il b. IsBlock il b => il -> b
Mark.plain (Paragraph Text -> Document Text)
-> (Paragraph Text -> Paragraph Text)
-> Paragraph Text
-> Document Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Paragraph Text -> Paragraph Text
forall a. IsInline a => a -> a
Mark.strong
  rawBlock :: Format -> Text -> Document Text
rawBlock Format
_ Text
_ = Document Text
forall a. Monoid a => a
mempty
  referenceLinkDefinition :: Text -> (Text, Text) -> Document Text
referenceLinkDefinition = Text -> (Text, Text) -> Document Text
forall a. Monoid a => a
mempty
  list :: ListType -> ListSpacing -> [Document Text] -> Document Text
list ListType
_type ListSpacing
_spacing = [Document Text] -> Document Text
forall a. Monoid a => [a] -> a
mconcat

parseSyntax :: Text -> Either String Syntax
parseSyntax :: Text -> Either String Syntax
parseSyntax Text
t = case Text -> Either Text (Maybe Syntax)
readTerm Text
t of
  Left Text
e -> String -> Either String Syntax
forall a b. a -> Either a b
Left (Text -> String
T.unpack Text
e)
  Right Maybe Syntax
Nothing -> String -> Either String Syntax
forall a b. a -> Either a b
Left String
"empty code"
  Right (Just Syntax
s) -> case Syntax -> Either ContextualTypeErr TSyntax
processParsedTerm Syntax
s of
    -- Just run the typechecker etc. to make sure the term typechecks
    Left ContextualTypeErr
e -> String -> Either String Syntax
forall a b. a -> Either a b
Left (Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> ContextualTypeErr -> Text
prettyTypeErrText Text
t ContextualTypeErr
e)
    -- ...but if it does, we just go back to using the original parsed
    -- (*unelaborated*) AST.  See #1496.
    Right TSyntax
_ -> Syntax -> Either String Syntax
forall a b. b -> Either a b
Right Syntax
s

findCode :: Document Syntax -> [Syntax]
findCode :: Document Syntax -> [Syntax]
findCode = (Paragraph Syntax -> [Syntax]) -> [Paragraph Syntax] -> [Syntax]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Node Syntax -> Maybe Syntax) -> [Node Syntax] -> [Syntax]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Node Syntax -> Maybe Syntax
forall {a}. Node a -> Maybe a
codeOnly ([Node Syntax] -> [Syntax])
-> (Paragraph Syntax -> [Node Syntax])
-> Paragraph Syntax
-> [Syntax]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Paragraph Syntax -> [Node Syntax]
forall c. Paragraph c -> [Node c]
nodes) ([Paragraph Syntax] -> [Syntax])
-> (Document Syntax -> [Paragraph Syntax])
-> Document Syntax
-> [Syntax]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document Syntax -> [Paragraph Syntax]
forall c. Document c -> [Paragraph c]
paragraphs
 where
  codeOnly :: Node a -> Maybe a
codeOnly = \case
    LeafCode a
s -> a -> Maybe a
forall a. a -> Maybe a
Just a
s
    LeafCodeBlock String
_i a
s -> a -> Maybe a
forall a. a -> Maybe a
Just a
s
    Node a
_l -> Maybe a
forall a. Maybe a
Nothing

instance ToJSON (Paragraph Syntax) where
  toJSON :: Paragraph Syntax -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (Paragraph Syntax -> Text) -> Paragraph Syntax -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Paragraph Syntax -> Text
forall a. ToStream a => a -> Text
toText

instance ToJSON (Document Syntax) where
  toJSON :: Document Syntax -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (Document Syntax -> Text) -> Document Syntax -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document Syntax -> Text
forall a. PrettyPrec a => Document a -> Text
docToMark

instance FromJSON (Document Syntax) where
  parseJSON :: Value -> Parser (Document Syntax)
parseJSON Value
v = Value -> Parser (Document Syntax)
parseDoc Value
v Parser (Document Syntax)
-> Parser (Document Syntax) -> Parser (Document Syntax)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> Parser (Document Syntax)
parsePars Value
v
   where
    parseDoc :: Value -> Parser (Document Syntax)
parseDoc = String
-> (Text -> Parser (Document Syntax))
-> Value
-> Parser (Document Syntax)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"markdown" Text -> Parser (Document Syntax)
forall (m :: * -> *). MonadFail m => Text -> m (Document Syntax)
fromTextM
    parsePars :: Value -> Parser (Document Syntax)
parsePars = String
-> (Array -> Parser (Document Syntax))
-> Value
-> Parser (Document Syntax)
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"markdown paragraphs" ((Array -> Parser (Document Syntax))
 -> Value -> Parser (Document Syntax))
-> (Array -> Parser (Document Syntax))
-> Value
-> Parser (Document Syntax)
forall a b. (a -> b) -> a -> b
$ \Array
a -> do
      ([Text]
ts :: [Text]) <- (Value -> Parser Text) -> [Value] -> Parser [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON ([Value] -> Parser [Text]) -> [Value] -> Parser [Text]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
toList Array
a
      Text -> Parser (Document Syntax)
forall (m :: * -> *). MonadFail m => Text -> m (Document Syntax)
fromTextM (Text -> Parser (Document Syntax))
-> Text -> Parser (Document Syntax)
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n\n" [Text]
ts

-- | Parse Markdown document, but re-inject a generated error into the
--   document itself.
fromText :: Text -> Document Syntax
fromText :: Text -> Document Syntax
fromText = (String -> Document Syntax)
-> (Document Syntax -> Document Syntax)
-> Either String (Document Syntax)
-> Document Syntax
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Document Syntax
forall {c}. String -> Document c
injectErr Document Syntax -> Document Syntax
forall a. a -> a
id (Either String (Document Syntax) -> Document Syntax)
-> (Text -> Either String (Document Syntax))
-> Text
-> Document Syntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Document Syntax)
fromTextE
 where
  injectErr :: String -> Document c
injectErr String
err = [Paragraph c] -> Document c
forall c. [Paragraph c] -> Document c
Document [[Node c] -> Paragraph c
forall c. [Node c] -> Paragraph c
Paragraph [String -> Text -> Node c
forall c. String -> Text -> Node c
LeafRaw String
"" (String -> Text
T.pack String
err)]]

-- | Read Markdown document and parse&validate the code.
--
-- If you want only the document with code as `Text`,
-- use the 'fromTextPure' function.
fromTextM :: MonadFail m => Text -> m (Document Syntax)
fromTextM :: forall (m :: * -> *). MonadFail m => Text -> m (Document Syntax)
fromTextM = (String -> m (Document Syntax))
-> (Document Syntax -> m (Document Syntax))
-> Either String (Document Syntax)
-> m (Document Syntax)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m (Document Syntax)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Document Syntax -> m (Document Syntax)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String (Document Syntax) -> m (Document Syntax))
-> (Text -> Either String (Document Syntax))
-> Text
-> m (Document Syntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Document Syntax)
fromTextE

fromTextE :: Text -> Either String (Document Syntax)
fromTextE :: Text -> Either String (Document Syntax)
fromTextE Text
t = Text -> Either String (Document Text)
fromTextPure Text
t Either String (Document Text)
-> (Document Text -> Either String (Document Syntax))
-> Either String (Document Syntax)
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Either String Syntax)
-> Document Text -> Either String (Document Syntax)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Document a -> f (Document b)
traverse Text -> Either String Syntax
parseSyntax

-- | Read Markdown document without code validation.
fromTextPure :: Text -> Either String (Document Text)
fromTextPure :: Text -> Either String (Document Text)
fromTextPure Text
t = do
  let spec :: SyntaxSpec Identity (Paragraph Text) (Document Text)
spec = SyntaxSpec Identity (Paragraph Text) (Document Text)
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
SyntaxSpec m il bl
Mark.rawAttributeSpec SyntaxSpec Identity (Paragraph Text) (Document Text)
-> SyntaxSpec Identity (Paragraph Text) (Document Text)
-> SyntaxSpec Identity (Paragraph Text) (Document Text)
forall a. Semigroup a => a -> a -> a
<> SyntaxSpec Identity (Paragraph Text) (Document Text)
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il) =>
SyntaxSpec m il bl
Mark.defaultSyntaxSpec SyntaxSpec Identity (Paragraph Text) (Document Text)
-> SyntaxSpec Identity (Paragraph Text) (Document Text)
-> SyntaxSpec Identity (Paragraph Text) (Document Text)
forall a. Semigroup a => a -> a -> a
<> SyntaxSpec Identity (Paragraph Text) (Document Text)
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
SyntaxSpec m il bl
Mark.rawAttributeSpec
  let runSimple :: Identity (Either ParseError d) -> Either String d
runSimple = (ParseError -> String) -> Either ParseError d -> Either String d
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ParseError -> String
forall a. Show a => a -> String
show (Either ParseError d -> Either String d)
-> (Identity (Either ParseError d) -> Either ParseError d)
-> Identity (Either ParseError d)
-> Either String d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Either ParseError d) -> Either ParseError d
forall a. Identity a -> a
runIdentity
  Document [Paragraph Text]
tokenizedDoc <- Identity (Either ParseError (Document Text))
-> Either String (Document Text)
forall {d}. Identity (Either ParseError d) -> Either String d
runSimple (Identity (Either ParseError (Document Text))
 -> Either String (Document Text))
-> Identity (Either ParseError (Document Text))
-> Either String (Document Text)
forall a b. (a -> b) -> a -> b
$ SyntaxSpec Identity (Paragraph Text) (Document Text)
-> String -> Text -> Identity (Either ParseError (Document Text))
forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il) =>
SyntaxSpec m il bl -> String -> Text -> m (Either ParseError bl)
Mark.commonmarkWith SyntaxSpec Identity (Paragraph Text) (Document Text)
spec String
"markdown" Text
t
  Document Text -> Either String (Document Text)
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Document Text -> Either String (Document Text))
-> ([Paragraph Text] -> Document Text)
-> [Paragraph Text]
-> Either String (Document Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Paragraph Text] -> Document Text
forall c. [Paragraph c] -> Document c
Document ([Paragraph Text] -> Either String (Document Text))
-> [Paragraph Text] -> Either String (Document Text)
forall a b. (a -> b) -> a -> b
$ Paragraph Text -> Paragraph Text
forall c. (Eq c, Semigroup c) => Paragraph c -> Paragraph c
normalise (Paragraph Text -> Paragraph Text)
-> [Paragraph Text] -> [Paragraph Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Paragraph Text]
tokenizedDoc

--------------------------------------------------------------
-- DIY STREAM
--------------------------------------------------------------

-- | Convert 'Document' to 'Text'.
--
-- Note that this will strip some markdown, emphasis and bold marks.
-- If you want to get markdown again, use 'docToMark'.
docToText :: PrettyPrec a => Document a -> Text
docToText :: forall a. PrettyPrec a => Document a -> Text
docToText = Text -> [Text] -> Text
T.intercalate Text
"\n\n" ([Text] -> Text) -> (Document a -> [Text]) -> Document a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Paragraph a -> Text) -> [Paragraph a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Paragraph a -> Text
forall a. ToStream a => a -> Text
toText ([Paragraph a] -> [Text])
-> (Document a -> [Paragraph a]) -> Document a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document a -> [Paragraph a]
forall c. Document c -> [Paragraph c]
paragraphs

-- | This is the naive and easy way to get text from markdown document.
toText :: ToStream a => a -> Text
toText :: forall a. ToStream a => a -> Text
toText = [StreamNode] -> Text
streamToText ([StreamNode] -> Text) -> (a -> [StreamNode]) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [StreamNode]
forall a. ToStream a => a -> [StreamNode]
toStream

-- | Token stream that can be easily converted to text or brick widgets.
--
-- TODO: #574 Code blocks should probably be handled separately.
data StreamNode' t
  = TextNode (Set TxtAttr) t
  | CodeNode t
  | RawNode String t
  deriving (StreamNode' t -> StreamNode' t -> Bool
(StreamNode' t -> StreamNode' t -> Bool)
-> (StreamNode' t -> StreamNode' t -> Bool) -> Eq (StreamNode' t)
forall t. Eq t => StreamNode' t -> StreamNode' t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall t. Eq t => StreamNode' t -> StreamNode' t -> Bool
== :: StreamNode' t -> StreamNode' t -> Bool
$c/= :: forall t. Eq t => StreamNode' t -> StreamNode' t -> Bool
/= :: StreamNode' t -> StreamNode' t -> Bool
Eq, Int -> StreamNode' t -> ShowS
[StreamNode' t] -> ShowS
StreamNode' t -> String
(Int -> StreamNode' t -> ShowS)
-> (StreamNode' t -> String)
-> ([StreamNode' t] -> ShowS)
-> Show (StreamNode' t)
forall t. Show t => Int -> StreamNode' t -> ShowS
forall t. Show t => [StreamNode' t] -> ShowS
forall t. Show t => StreamNode' t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall t. Show t => Int -> StreamNode' t -> ShowS
showsPrec :: Int -> StreamNode' t -> ShowS
$cshow :: forall t. Show t => StreamNode' t -> String
show :: StreamNode' t -> String
$cshowList :: forall t. Show t => [StreamNode' t] -> ShowS
showList :: [StreamNode' t] -> ShowS
Show, (forall a b. (a -> b) -> StreamNode' a -> StreamNode' b)
-> (forall a b. a -> StreamNode' b -> StreamNode' a)
-> Functor StreamNode'
forall a b. a -> StreamNode' b -> StreamNode' a
forall a b. (a -> b) -> StreamNode' a -> StreamNode' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> StreamNode' a -> StreamNode' b
fmap :: forall a b. (a -> b) -> StreamNode' a -> StreamNode' b
$c<$ :: forall a b. a -> StreamNode' b -> StreamNode' a
<$ :: forall a b. a -> StreamNode' b -> StreamNode' a
Functor)

type StreamNode = StreamNode' Text

unStream :: StreamNode' t -> (t -> StreamNode' t, t)
unStream :: forall t. StreamNode' t -> (t -> StreamNode' t, t)
unStream = \case
  TextNode Set TxtAttr
a t
t -> (Set TxtAttr -> t -> StreamNode' t
forall t. Set TxtAttr -> t -> StreamNode' t
TextNode Set TxtAttr
a, t
t)
  CodeNode t
t -> (t -> StreamNode' t
forall t. t -> StreamNode' t
CodeNode, t
t)
  RawNode String
a t
t -> (String -> t -> StreamNode' t
forall t. String -> t -> StreamNode' t
RawNode String
a, t
t)

-- | Get chunks of nodes not exceeding length and broken at word boundary.
chunksOf :: Int -> [StreamNode] -> [[StreamNode]]
chunksOf :: Int -> [StreamNode] -> [[StreamNode]]
chunksOf Int
n = ([StreamNode] -> ([StreamNode], [StreamNode]))
-> [StreamNode] -> [[StreamNode]]
forall a b. ([a] -> (b, [a])) -> [a] -> [b]
chop (Bool -> Int -> [StreamNode] -> ([StreamNode], [StreamNode])
splitter Bool
True Int
n)
 where
  nodeLength :: StreamNode -> Int
  nodeLength :: StreamNode -> Int
nodeLength = Text -> Int
T.length (Text -> Int) -> (StreamNode -> Text) -> StreamNode -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> StreamNode, Text) -> Text
forall a b. (a, b) -> b
snd ((Text -> StreamNode, Text) -> Text)
-> (StreamNode -> (Text -> StreamNode, Text)) -> StreamNode -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamNode -> (Text -> StreamNode, Text)
forall t. StreamNode' t -> (t -> StreamNode' t, t)
unStream
  splitter :: Bool -> Int -> [StreamNode] -> ([StreamNode], [StreamNode])
  splitter :: Bool -> Int -> [StreamNode] -> ([StreamNode], [StreamNode])
splitter Bool
start Int
i = \case
    [] -> ([], [])
    (StreamNode
tn : [StreamNode]
ss) ->
      let l :: Int
l = StreamNode -> Int
nodeLength StreamNode
tn
       in if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i
            then ([StreamNode] -> [StreamNode])
-> ([StreamNode], [StreamNode]) -> ([StreamNode], [StreamNode])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (StreamNode
tn StreamNode -> [StreamNode] -> [StreamNode]
forall a. a -> [a] -> [a]
:) (([StreamNode], [StreamNode]) -> ([StreamNode], [StreamNode]))
-> ([StreamNode], [StreamNode]) -> ([StreamNode], [StreamNode])
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> [StreamNode] -> ([StreamNode], [StreamNode])
splitter Bool
False (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l) [StreamNode]
ss
            else let (StreamNode
tn1, StreamNode
tn2) = Bool -> Int -> StreamNode -> (StreamNode, StreamNode)
cut Bool
start Int
i StreamNode
tn in ([StreamNode
tn1], StreamNode
tn2 StreamNode -> [StreamNode] -> [StreamNode]
forall a. a -> [a] -> [a]
: [StreamNode]
ss)
  cut :: Bool -> Int -> StreamNode -> (StreamNode, StreamNode)
  cut :: Bool -> Int -> StreamNode -> (StreamNode, StreamNode)
cut Bool
start Int
i StreamNode
tn =
    let (Text -> StreamNode
con, Text
t) = StreamNode -> (Text -> StreamNode, Text)
forall t. StreamNode' t -> (t -> StreamNode' t, t)
unStream StreamNode
tn
        endSpace :: Text
endSpace = (Char -> Bool) -> Text -> Text
T.takeWhileEnd Char -> Bool
isSpace Text
t
        startSpace :: Text
startSpace = (Char -> Bool) -> Text -> Text
T.takeWhile Char -> Bool
isSpace Text
t
        twords :: [Text]
twords = Text -> [Text]
T.words Text
t [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> [Text] -> Identity [Text]
forall s a. Cons s s a a => Traversal' s a
Traversal' [Text] Text
_head ((Text -> Identity Text) -> [Text] -> Identity [Text])
-> (Text -> Text) -> [Text] -> [Text]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
startSpace Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> [Text] -> Identity [Text]
forall s a. Snoc s s a a => Traversal' s a
Traversal' [Text] Text
_last ((Text -> Identity Text) -> [Text] -> Identity [Text])
-> (Text -> Text) -> [Text] -> [Text]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
endSpace)
     in case Int -> [Text] -> ([Text], [Text])
splitWordsAt Int
i [Text]
twords of
          ([], []) -> (Text -> StreamNode
con Text
"", Text -> StreamNode
con Text
"")
          ([], ws :: [Text]
ws@(Text
ww : [Text]
wws)) ->
            ([Text] -> StreamNode)
-> ([Text], [Text]) -> (StreamNode, StreamNode)
forall a b. (a -> b) -> (a, a) -> (b, b)
both (Text -> StreamNode
con (Text -> StreamNode) -> ([Text] -> Text) -> [Text] -> StreamNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords) (([Text], [Text]) -> (StreamNode, StreamNode))
-> ([Text], [Text]) -> (StreamNode, StreamNode)
forall a b. (a -> b) -> a -> b
$
              -- In case single word (e.g. web link) does not fit on line we must put
              -- it there and guarantee progress (otherwise chop will cycle)
              if Bool
start then ([Int -> Text -> Text
T.take Int
i Text
ww], Int -> Text -> Text
T.drop Int
i Text
ww Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
wws) else ([], [Text]
ws)
          ([Text], [Text])
splitted -> ([Text] -> StreamNode)
-> ([Text], [Text]) -> (StreamNode, StreamNode)
forall a b. (a -> b) -> (a, a) -> (b, b)
both (Text -> StreamNode
con (Text -> StreamNode) -> ([Text] -> Text) -> [Text] -> StreamNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords) ([Text], [Text])
splitted

splitWordsAt :: Int -> [Text] -> ([Text], [Text])
splitWordsAt :: Int -> [Text] -> ([Text], [Text])
splitWordsAt Int
i = \case
  [] -> ([], [])
  (Text
w : [Text]
ws) ->
    let l :: Int
l = Text -> Int
T.length Text
w
     in if Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
i
          then ([Text] -> [Text]) -> ([Text], [Text]) -> ([Text], [Text])
forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Text
w Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) (([Text], [Text]) -> ([Text], [Text]))
-> ([Text], [Text]) -> ([Text], [Text])
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> ([Text], [Text])
splitWordsAt (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) [Text]
ws
          else ([], Text
w Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
ws)

streamToText :: [StreamNode] -> Text
streamToText :: [StreamNode] -> Text
streamToText = [Text] -> Text
T.concat ([Text] -> Text)
-> ([StreamNode] -> [Text]) -> [StreamNode] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StreamNode -> Text) -> [StreamNode] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map StreamNode -> Text
forall {t}. StreamNode' t -> t
nodeToText
 where
  nodeToText :: StreamNode' t -> t
nodeToText = \case
    TextNode Set TxtAttr
_a t
t -> t
t
    RawNode String
_s t
t -> t
t
    CodeNode t
stx -> t
stx

-- | Convert elements to one dimensional stream of nodes,
-- that is easy to format and layout.
--
-- If you want to split the stream at line length, use
-- the 'chunksOf' function afterward.
class ToStream a where
  toStream :: a -> [StreamNode]

instance PrettyPrec a => ToStream (Node a) where
  toStream :: Node a -> [StreamNode]
toStream = \case
    LeafText Set TxtAttr
a Text
t -> [Set TxtAttr -> Text -> StreamNode
forall t. Set TxtAttr -> t -> StreamNode' t
TextNode Set TxtAttr
a Text
t]
    LeafCode a
t -> [Text -> StreamNode
forall t. t -> StreamNode' t
CodeNode (a -> Text
forall a. PrettyPrec a => a -> Text
prettyTextLine a
t)]
    LeafRaw String
s Text
t -> [String -> Text -> StreamNode
forall t. String -> t -> StreamNode' t
RawNode String
s Text
t]
    LeafCodeBlock String
_i a
t -> [Text -> StreamNode
forall t. t -> StreamNode' t
CodeNode (a -> Text
forall a. PrettyPrec a => a -> Text
prettyText a
t)]

instance PrettyPrec a => ToStream (Paragraph a) where
  toStream :: Paragraph a -> [StreamNode]
toStream = (Node a -> [StreamNode]) -> [Node a] -> [StreamNode]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Node a -> [StreamNode]
forall a. ToStream a => a -> [StreamNode]
toStream ([Node a] -> [StreamNode])
-> (Paragraph a -> [Node a]) -> Paragraph a -> [StreamNode]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Paragraph a -> [Node a]
forall c. Paragraph c -> [Node c]
nodes

--------------------------------------------------------------
-- Markdown
--------------------------------------------------------------

nodeToMark :: PrettyPrec a => Node a -> Text
nodeToMark :: forall a. PrettyPrec a => Node a -> Text
nodeToMark = \case
  LeafText Set TxtAttr
a Text
t -> (Text -> TxtAttr -> Text) -> Text -> Set TxtAttr -> Text
forall b a. (b -> a -> b) -> b -> Set a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Text -> TxtAttr -> Text
forall {a}. (Semigroup a, IsString a) => a -> TxtAttr -> a
attr Text
t Set TxtAttr
a
  LeafRaw String
_ Text
c -> Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
wrap Text
"`" Text
c
  LeafCode a
c -> Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
wrap Text
"`" (a -> Text
forall a. PrettyPrec a => a -> Text
prettyText a
c)
  LeafCodeBlock String
f a
c -> String -> Text -> Text
codeBlock String
f (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. PrettyPrec a => a -> Text
prettyText a
c
 where
  codeBlock :: String -> Text -> Text
codeBlock String
f Text
t = Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
wrap Text
"```" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
f Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  wrap :: a -> a -> a
wrap a
c a
t = a
c a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
t a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
c
  attr :: a -> TxtAttr -> a
attr a
t TxtAttr
a = case TxtAttr
a of
    TxtAttr
Emphasis -> a -> a -> a
forall a. Semigroup a => a -> a -> a
wrap a
"_" a
t
    TxtAttr
Strong -> a -> a -> a
forall a. Semigroup a => a -> a -> a
wrap a
"**" a
t

paragraphToMark :: PrettyPrec a => Paragraph a -> Text
paragraphToMark :: forall a. PrettyPrec a => Paragraph a -> Text
paragraphToMark = (Node a -> Text) -> [Node a] -> Text
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Node a -> Text
forall a. PrettyPrec a => Node a -> Text
nodeToMark ([Node a] -> Text)
-> (Paragraph a -> [Node a]) -> Paragraph a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Paragraph a -> [Node a]
forall c. Paragraph c -> [Node c]
nodes

-- | Convert 'Document' to markdown text.
docToMark :: PrettyPrec a => Document a -> Text
docToMark :: forall a. PrettyPrec a => Document a -> Text
docToMark = Text -> [Text] -> Text
T.intercalate Text
"\n\n" ([Text] -> Text) -> (Document a -> [Text]) -> Document a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Paragraph a -> Text) -> [Paragraph a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Paragraph a -> Text
forall a. PrettyPrec a => Paragraph a -> Text
paragraphToMark ([Paragraph a] -> [Text])
-> (Document a -> [Paragraph a]) -> Document a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document a -> [Paragraph a]
forall c. Document c -> [Paragraph c]
paragraphs