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

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Simple Markdown AST and related utilities.
--
-- Parametrising '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 (catMaybes)
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.Parse (readTerm)
import Swarm.Language.Pipeline (processParsedTerm)
import Swarm.Language.Pretty (PrettyPrec (..), prettyText, prettyTextLine, prettyTypeErrText)
import Swarm.Language.Syntax (Syntax)

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

txt :: Text -> Node c
txt :: forall c. Text -> Node c
txt = forall c. Set TxtAttr -> Text -> Node c
LeafText 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) = forall c. Set TxtAttr -> Text -> Node c
LeafText (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) = forall c. [Node c] -> Paragraph c
Paragraph forall a b. (a -> b) -> a -> b
$ 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') = forall {c} {c}. Node c -> [Node c] -> (Node c, [Node c])
mergeSame Node c
n [Node c]
ns in Node c
n' 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 forall a. Eq a => a -> a -> Bool
== Set TxtAttr
attrs2 -> Node c -> [Node c] -> (Node c, [Node c])
mergeSame (forall c. Set TxtAttr -> Text -> Node c
LeafText Set TxtAttr
attrs1 forall a b. (a -> b) -> a -> b
$ Text
t1 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxtAttr -> TxtAttr -> Bool
$c/= :: TxtAttr -> TxtAttr -> Bool
== :: TxtAttr -> TxtAttr -> Bool
$c== :: TxtAttr -> TxtAttr -> Bool
Eq, Int -> TxtAttr -> ShowS
[TxtAttr] -> ShowS
TxtAttr -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxtAttr] -> ShowS
$cshowList :: [TxtAttr] -> ShowS
show :: TxtAttr -> String
$cshow :: TxtAttr -> String
showsPrec :: Int -> TxtAttr -> ShowS
$cshowsPrec :: Int -> TxtAttr -> ShowS
Show, Eq 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
min :: TxtAttr -> TxtAttr -> TxtAttr
$cmin :: TxtAttr -> TxtAttr -> TxtAttr
max :: TxtAttr -> TxtAttr -> TxtAttr
$cmax :: TxtAttr -> TxtAttr -> TxtAttr
>= :: TxtAttr -> TxtAttr -> Bool
$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
compare :: TxtAttr -> TxtAttr -> Ordering
$ccompare :: TxtAttr -> TxtAttr -> Ordering
Ord)

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

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

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

instance Mark.HasAttributes (Document c) where
  addAttributes :: Attributes -> Document c -> Document c
addAttributes Attributes
_ = 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 = forall c. Document c -> [Paragraph c]
paragraphs
  fromList :: [Item (Document a)] -> Document a
fromList = forall c. [Paragraph c] -> Document c
Document

instance GHC.Exts.IsString (Document Syntax) where
  fromString :: String -> Document Syntax
fromString = Text -> Document Syntax
fromText 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 forall c. Document c -> [Paragraph c]
paragraphs forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
GHC.Exts.fromString String
s of
    [] -> forall a. Monoid a => a
mempty
    [Paragraph Syntax
p] -> Paragraph Syntax
p
    [Paragraph Syntax]
ps -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Error: expected one paragraph, but found " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Paragraph Syntax]
ps)

-- | 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 = forall c. Node c -> Paragraph c
pureP forall a b. (a -> b) -> a -> b
$ forall c. Text -> Node c
txt Text
"\n"
  softBreak :: Paragraph Text
softBreak = forall c. Node c -> Paragraph c
pureP forall a b. (a -> b) -> a -> b
$ forall c. Text -> Node c
txt Text
" "
  str :: Text -> Paragraph Text
str = forall c. Node c -> Paragraph c
pureP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Text -> Node c
txt
  entity :: Text -> Paragraph Text
entity = forall a. IsInline a => Text -> a
Mark.str
  escapedChar :: Char -> Paragraph Text
escapedChar Char
c = forall a. IsInline a => Text -> a
Mark.str forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack [Char
'\\', Char
c]
  emph :: Paragraph Text -> Paragraph Text
emph = forall c. (Node c -> Node c) -> Paragraph c -> Paragraph c
mapP forall a b. (a -> b) -> a -> b
$ forall c. TxtAttr -> Node c -> Node c
addTextAttribute TxtAttr
Emphasis
  strong :: Paragraph Text -> Paragraph Text
strong = forall c. (Node c -> Node c) -> Paragraph c -> Paragraph c
mapP forall a b. (a -> b) -> a -> b
$ 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 = forall c. Node c -> Paragraph c
pureP (forall c. Text -> Node c
txt Text
"[") forall a. Semigroup a => a -> a -> a
<> Paragraph Text
desc forall a. Semigroup a => a -> a -> a
<> forall c. Node c -> Paragraph c
pureP (forall c. Text -> Node c
txt forall a b. (a -> b) -> a -> b
$ Text
"](" forall a. Semigroup a => a -> a -> a
<> Text
dest forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteMaybe Text
title forall a. Semigroup a => a -> a -> a
<> Text
")")
  image :: Text -> Text -> Paragraph Text -> Paragraph Text
image Text
dest Text
title Paragraph Text
desc = forall c. Node c -> Paragraph c
pureP (forall c. Text -> Node c
txt Text
"!") forall a. Semigroup a => a -> a -> a
<> forall a. IsInline a => Text -> Text -> a -> a
Mark.link Text
dest Text
title Paragraph Text
desc
  code :: Text -> Paragraph Text
code = forall c. Node c -> Paragraph c
pureP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. c -> Node c
LeafCode
  rawInline :: Format -> Text -> Paragraph Text
rawInline (Mark.Format Text
f) = forall c. Node c -> Paragraph c
pureP forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall c. [Paragraph c] -> Document c
Document forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
: [])
  plain :: Paragraph Text -> Document Text
plain = forall il b. IsBlock il b => il -> b
Mark.paragraph
  thematicBreak :: Document Text
thematicBreak = forall a. Monoid a => a
mempty
  blockQuote :: Document Text -> Document Text
blockQuote (Document [Paragraph Text]
ns) = forall c. [Paragraph c] -> Document c
Document forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. IsInline a => a -> a
Mark.emph [Paragraph Text]
ns
  codeBlock :: Text -> Text -> Document Text
codeBlock Text
f = forall il b. IsBlock il b => il -> b
Mark.plain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Node c -> Paragraph c
pureP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. String -> c -> Node c
LeafCodeBlock (Text -> String
T.unpack Text
f)
  heading :: Int -> Paragraph Text -> Document Text
heading Int
_lvl = forall il b. IsBlock il b => il -> b
Mark.plain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsInline a => a -> a
Mark.strong
  rawBlock :: Format -> Text -> Document Text
rawBlock (Mark.Format Text
f) Text
t = forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack forall a b. (a -> b) -> a -> b
$ Text
"Unsupported raw " forall a. Semigroup a => a -> a -> a
<> Text
f forall a. Semigroup a => a -> a -> a
<> Text
" block:\n" forall a. Semigroup a => a -> a -> a
<> Text
t
  referenceLinkDefinition :: Text -> (Text, Text) -> Document Text
referenceLinkDefinition = forall a. Monoid a => a
mempty
  list :: ListType -> ListSpacing -> [Document Text] -> Document Text
list ListType
_type ListSpacing
_spacing = 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 -> forall a b. a -> Either a b
Left (Text -> String
T.unpack Text
e)
  Right Maybe Syntax
Nothing -> forall a b. a -> Either a b
Left String
"empty code"
  Right (Just Syntax
s) -> case Syntax -> Either ContextualTypeErr ProcessedTerm
processParsedTerm Syntax
s of
    -- Just run the typechecker etc. to make sure the term typechecks
    Left ContextualTypeErr
e -> forall a b. a -> Either a b
Left (Text -> String
T.unpack 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 ProcessedTerm
_ -> forall a b. b -> Either a b
Right Syntax
s

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

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

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

-- | Parse Markdown document, but throw on invalid code.
fromText :: Text -> Document Syntax
fromText :: Text -> Document Syntax
fromText = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => String -> a
error forall a. a -> a
id forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String (Document Syntax)
fromTextE

-- | 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 = forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl) =>
SyntaxSpec m il bl
Mark.rawAttributeSpec forall a. Semigroup a => a -> a -> a
<> forall (m :: * -> *) il bl.
(Monad m, IsBlock il bl, IsInline il) =>
SyntaxSpec m il bl
Mark.defaultSyntaxSpec forall a. Semigroup a => a -> a -> a
<> 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 = forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity
  Document [Paragraph Text]
tokenizedDoc <- forall {d}. Identity (Either ParseError d) -> Either String d
runSimple forall a b. (a -> b) -> a -> b
$ 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
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. [Paragraph c] -> Document c
Document forall a b. (a -> b) -> a -> b
$ forall c. (Eq c, Semigroup c) => Paragraph c -> Paragraph c
normalise 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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. ToStream a => a -> Text
toText forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall t. Eq t => StreamNode' t -> StreamNode' t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamNode' t -> StreamNode' t -> Bool
$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
Eq, Int -> StreamNode' t -> ShowS
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
showList :: [StreamNode' t] -> ShowS
$cshowList :: forall t. Show t => [StreamNode' t] -> ShowS
show :: StreamNode' t -> String
$cshow :: forall t. Show t => StreamNode' t -> String
showsPrec :: Int -> StreamNode' t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> StreamNode' t -> ShowS
Show, 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
<$ :: forall a b. a -> StreamNode' b -> StreamNode' a
$c<$ :: forall a b. a -> StreamNode' b -> StreamNode' a
fmap :: forall a b. (a -> b) -> StreamNode' a -> StreamNode' b
$cfmap :: forall a b. (a -> b) -> StreamNode' a -> StreamNode' b
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 -> (forall t. Set TxtAttr -> t -> StreamNode' t
TextNode Set TxtAttr
a, t
t)
  CodeNode t
t -> (forall t. t -> StreamNode' t
CodeNode, t
t)
  RawNode String
a t
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 = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Ord a => a -> a -> Bool
<= Int
i
            then forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (StreamNode
tn forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ Bool -> Int -> [StreamNode] -> ([StreamNode], [StreamNode])
splitter Bool
False (Int
i 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 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) = 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 forall a b. a -> (a -> b) -> b
& forall s a. Cons s s a a => Traversal' s a
_head forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Text
startSpace forall a. Semigroup a => a -> a -> a
<>) forall a b. a -> (a -> b) -> b
& forall s a. Snoc s s a a => Traversal' s a
_last forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (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)) ->
            forall a b. (a -> b) -> (a, a) -> (b, b)
both (Text -> StreamNode
con forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unwords) 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 forall a. a -> [a] -> [a]
: [Text]
wws) else ([], [Text]
ws)
          ([Text], [Text])
splitted -> forall a b. (a -> b) -> (a, a) -> (b, b)
both (Text -> StreamNode
con 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 forall a. Ord a => a -> a -> Bool
< Int
i
          then forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (Text
w forall a. a -> [a] -> [a]
:) forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> ([Text], [Text])
splitWordsAt (Int
i forall a. Num a => a -> a -> a
- Int
l forall a. Num a => a -> a -> a
- Int
1) [Text]
ws
          else ([], Text
w forall a. a -> [a] -> [a]
: [Text]
ws)

streamToText :: [StreamNode] -> Text
streamToText :: [StreamNode] -> Text
streamToText = [Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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 -> [forall t. Set TxtAttr -> t -> StreamNode' t
TextNode Set TxtAttr
a Text
t]
    LeafCode a
t -> [forall t. t -> StreamNode' t
CodeNode (forall a. PrettyPrec a => a -> Text
prettyTextLine a
t)]
    LeafRaw String
s Text
t -> [forall t. String -> t -> StreamNode' t
RawNode String
s Text
t]
    LeafCodeBlock String
_i a
t -> [forall t. t -> StreamNode' t
CodeNode (forall a. PrettyPrec a => a -> Text
prettyText a
t)]

instance PrettyPrec a => ToStream (Paragraph a) where
  toStream :: Paragraph a -> [StreamNode]
toStream = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. ToStream a => a -> [StreamNode]
toStream forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {a}. (Semigroup a, IsString a) => a -> TxtAttr -> a
attr Text
t Set TxtAttr
a
  LeafRaw String
_ Text
c -> forall a. Semigroup a => a -> a -> a
wrap Text
"`" Text
c
  LeafCode a
c -> forall a. Semigroup a => a -> a -> a
wrap Text
"`" (forall a. PrettyPrec a => a -> Text
prettyText a
c)
  LeafCodeBlock String
f a
c -> String -> Text -> Text
codeBlock String
f forall a b. (a -> b) -> a -> b
$ forall a. PrettyPrec a => a -> Text
prettyText a
c
 where
  codeBlock :: String -> Text -> Text
codeBlock String
f Text
t = forall a. Semigroup a => a -> a -> a
wrap Text
"```" forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
f forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  wrap :: a -> a -> a
wrap a
c a
t = a
c forall a. Semigroup a => a -> a -> a
<> a
t forall a. Semigroup a => a -> a -> a
<> a
c
  attr :: a -> TxtAttr -> a
attr a
t TxtAttr
a = case TxtAttr
a of
    TxtAttr
Emphasis -> forall a. Semigroup a => a -> a -> a
wrap a
"_" a
t
    TxtAttr
Strong -> 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 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. PrettyPrec a => Node a -> Text
nodeToMark forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. PrettyPrec a => Paragraph a -> Text
paragraphToMark forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Document c -> [Paragraph c]
paragraphs