module Options.Applicative.Help.Chunk
( mappendWith
, Chunk(..)
, chunked
, listToChunk
, (<<+>>)
, (<</>>)
, vcatChunks
, vsepChunks
, isEmpty
, stringChunk
, paragraph
, extractChunk
, tabulate
) where
import Control.Applicative
import Control.Monad
import Data.Maybe
import Data.Semigroup
import Prelude
import Options.Applicative.Help.Pretty
mappendWith :: Monoid a => a -> a -> a -> a
mappendWith s x y = mconcat [x, s, y]
newtype Chunk a = Chunk
{ unChunk :: Maybe a }
deriving (Eq, Show)
instance Functor Chunk where
fmap f = Chunk . fmap f . unChunk
instance Applicative Chunk where
pure = Chunk . pure
Chunk f <*> Chunk x = Chunk (f <*> x)
instance Alternative Chunk where
empty = Chunk Control.Applicative.empty
a <|> b = Chunk $ unChunk a <|> unChunk b
instance Monad Chunk where
return = pure
m >>= f = Chunk $ unChunk m >>= unChunk . f
instance Monoid a => Semigroup (Chunk a) where
(<>) = chunked mappend
instance Monoid a => Monoid (Chunk a) where
mempty = Chunk Nothing
mappend = (<>)
instance MonadPlus Chunk where
mzero = Chunk mzero
mplus m1 m2 = Chunk $ mplus (unChunk m1) (unChunk m2)
chunked :: (a -> a -> a)
-> Chunk a -> Chunk a -> Chunk a
chunked _ (Chunk Nothing) y = y
chunked _ x (Chunk Nothing) = x
chunked f (Chunk (Just x)) (Chunk (Just y)) = Chunk (Just (f x y))
listToChunk :: Monoid a => [a] -> Chunk a
listToChunk [] = mempty
listToChunk xs = pure (mconcat xs)
extractChunk :: Monoid a => Chunk a -> a
extractChunk = fromMaybe mempty . unChunk
(<<+>>) :: Chunk Doc -> Chunk Doc -> Chunk Doc
(<<+>>) = chunked (<+>)
(<</>>) :: Chunk Doc -> Chunk Doc -> Chunk Doc
(<</>>) = chunked (</>)
vcatChunks :: [Chunk Doc] -> Chunk Doc
vcatChunks = foldr (chunked (.$.)) mempty
vsepChunks :: [Chunk Doc] -> Chunk Doc
vsepChunks = foldr (chunked (\x y -> x .$. mempty .$. y)) mempty
isEmpty :: Chunk a -> Bool
isEmpty = isNothing . unChunk
stringChunk :: String -> Chunk Doc
stringChunk "" = mempty
stringChunk s = pure (string s)
paragraph :: String -> Chunk Doc
paragraph = foldr (chunked (</>) . stringChunk) mempty
. words
tabulate' :: Int -> [(Doc, Doc)] -> Chunk Doc
tabulate' _ [] = mempty
tabulate' size table = pure $ vcat
[ indent 2 (fillBreak size key <+> value)
| (key, value) <- table ]
tabulate :: [(Doc, Doc)] -> Chunk Doc
tabulate = tabulate' 24