1module Options.Applicative.Help.Chunk 2 ( mappendWith 3 , Chunk(..) 4 , chunked 5 , listToChunk 6 , (<<+>>) 7 , (<</>>) 8 , vcatChunks 9 , vsepChunks 10 , isEmpty 11 , stringChunk 12 , paragraph 13 , extractChunk 14 , tabulate 15 ) where 16 17import Control.Applicative 18import Control.Monad 19import Data.List.NonEmpty (NonEmpty(..)) 20import Data.Maybe 21import Data.Semigroup 22import Prelude 23 24import Options.Applicative.Help.Pretty 25 26mappendWith :: Monoid a => a -> a -> a -> a 27mappendWith s x y = mconcat [x, s, y] 28 29-- | The free monoid on a semigroup 'a'. 30newtype Chunk a = Chunk 31 { unChunk :: Maybe a } 32 deriving (Eq, Show) 33 34instance Functor Chunk where 35 fmap f = Chunk . fmap f . unChunk 36 37instance Applicative Chunk where 38 pure = Chunk . pure 39 Chunk f <*> Chunk x = Chunk (f <*> x) 40 41instance Alternative Chunk where 42 empty = Chunk Control.Applicative.empty 43 a <|> b = Chunk $ unChunk a <|> unChunk b 44 45instance Monad Chunk where 46 return = pure 47 m >>= f = Chunk $ unChunk m >>= unChunk . f 48 49instance Semigroup a => Semigroup (Chunk a) where 50 (<>) = chunked (<>) 51 52instance Semigroup a => Monoid (Chunk a) where 53 mempty = Chunk Nothing 54 mappend = (<>) 55 56instance MonadPlus Chunk where 57 mzero = Chunk mzero 58 mplus m1 m2 = Chunk $ mplus (unChunk m1) (unChunk m2) 59 60-- | Given a semigroup structure on 'a', return a monoid structure on 'Chunk a'. 61-- 62-- Note that this is /not/ the same as 'liftA2'. 63chunked :: (a -> a -> a) 64 -> Chunk a -> Chunk a -> Chunk a 65chunked _ (Chunk Nothing) y = y 66chunked _ x (Chunk Nothing) = x 67chunked f (Chunk (Just x)) (Chunk (Just y)) = Chunk (Just (f x y)) 68 69-- | Concatenate a list into a Chunk. 'listToChunk' satisfies: 70-- 71-- > isEmpty . listToChunk = null 72-- > listToChunk = mconcat . fmap pure 73listToChunk :: Semigroup a => [a] -> Chunk a 74listToChunk [] = mempty 75listToChunk (x:xs) = pure (sconcat (x :| xs)) 76 77-- | Part of a constrained comonad instance. 78-- 79-- This is the counit of the adjunction between 'Chunk' and the forgetful 80-- functor from monoids to semigroups. It satisfies: 81-- 82-- > extractChunk . pure = id 83-- > extractChunk . fmap pure = id 84extractChunk :: Monoid a => Chunk a -> a 85extractChunk = fromMaybe mempty . unChunk 86-- we could also define: 87-- duplicate :: Monoid a => Chunk a -> Chunk (Chunk a) 88-- duplicate = fmap pure 89 90-- | Concatenate two 'Chunk's with a space in between. If one is empty, this 91-- just returns the other one. 92-- 93-- Unlike '<+>' for 'Doc', this operation has a unit element, namely the empty 94-- 'Chunk'. 95(<<+>>) :: Chunk Doc -> Chunk Doc -> Chunk Doc 96(<<+>>) = chunked (<+>) 97 98-- | Concatenate two 'Chunk's with a softline in between. This is exactly like 99-- '<<+>>', but uses a softline instead of a space. 100(<</>>) :: Chunk Doc -> Chunk Doc -> Chunk Doc 101(<</>>) = chunked (</>) 102 103-- | Concatenate 'Chunk's vertically. 104vcatChunks :: [Chunk Doc] -> Chunk Doc 105vcatChunks = foldr (chunked (.$.)) mempty 106 107-- | Concatenate 'Chunk's vertically separated by empty lines. 108vsepChunks :: [Chunk Doc] -> Chunk Doc 109vsepChunks = foldr (chunked (\x y -> x .$. mempty .$. y)) mempty 110 111-- | Whether a 'Chunk' is empty. Note that something like 'pure mempty' is not 112-- considered an empty chunk, even though the underlying 'Doc' is empty. 113isEmpty :: Chunk a -> Bool 114isEmpty = isNothing . unChunk 115 116-- | Convert a 'String' into a 'Chunk'. This satisfies: 117-- 118-- > isEmpty . stringChunk = null 119-- > extractChunk . stringChunk = string 120stringChunk :: String -> Chunk Doc 121stringChunk "" = mempty 122stringChunk s = pure (string s) 123 124-- | Convert a paragraph into a 'Chunk'. The resulting chunk is composed by the 125-- words of the original paragraph separated by softlines, so it will be 126-- automatically word-wrapped when rendering the underlying document. 127-- 128-- This satisfies: 129-- 130-- > isEmpty . paragraph = null . words 131paragraph :: String -> Chunk Doc 132paragraph = foldr (chunked (</>) . stringChunk) mempty 133 . words 134 135tabulate' :: Int -> [(Doc, Doc)] -> Chunk Doc 136tabulate' _ [] = mempty 137tabulate' size table = pure $ vcat 138 [ indent 2 (fillBreak size key <+> value) 139 | (key, value) <- table ] 140 141-- | Display pairs of strings in a table. 142tabulate :: [(Doc, Doc)] -> Chunk Doc 143tabulate = tabulate' 24 144