{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
module Options.Applicative.Help.Chunk
  ( Chunk(..)
  , chunked
  , listToChunk
  , (<<+>>)
  , (<</>>)
  , vcatChunks
  , vsepChunks
  , isEmpty
  , stringChunk
  , paragraph
  , extractChunk
  , tabulate
  ) where

import Control.Applicative
import Control.Monad
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe
import Data.Semigroup
import Prelude

import Options.Applicative.Help.Pretty

-- | The free monoid on a semigroup 'a'.
newtype Chunk a = Chunk
  { forall a. Chunk a -> Maybe a
unChunk :: Maybe a }
  deriving (Chunk a -> Chunk a -> Bool
forall a. Eq a => Chunk a -> Chunk a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chunk a -> Chunk a -> Bool
$c/= :: forall a. Eq a => Chunk a -> Chunk a -> Bool
== :: Chunk a -> Chunk a -> Bool
$c== :: forall a. Eq a => Chunk a -> Chunk a -> Bool
Eq, Int -> Chunk a -> ShowS
forall a. Show a => Int -> Chunk a -> ShowS
forall a. Show a => [Chunk a] -> ShowS
forall a. Show a => Chunk a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Chunk a] -> ShowS
$cshowList :: forall a. Show a => [Chunk a] -> ShowS
show :: Chunk a -> String
$cshow :: forall a. Show a => Chunk a -> String
showsPrec :: Int -> Chunk a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Chunk a -> ShowS
Show)

instance Functor Chunk where
  fmap :: forall a b. (a -> b) -> Chunk a -> Chunk b
fmap a -> b
f = forall a. Maybe a -> Chunk a
Chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Chunk a -> Maybe a
unChunk

instance Applicative Chunk where
  pure :: forall a. a -> Chunk a
pure = forall a. Maybe a -> Chunk a
Chunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Chunk Maybe (a -> b)
f <*> :: forall a b. Chunk (a -> b) -> Chunk a -> Chunk b
<*> Chunk Maybe a
x = forall a. Maybe a -> Chunk a
Chunk (Maybe (a -> b)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a
x)

instance Alternative Chunk where
  empty :: forall a. Chunk a
empty = forall a. Maybe a -> Chunk a
Chunk forall (f :: * -> *) a. Alternative f => f a
Control.Applicative.empty
  Chunk a
a <|> :: forall a. Chunk a -> Chunk a -> Chunk a
<|> Chunk a
b = forall a. Maybe a -> Chunk a
Chunk forall a b. (a -> b) -> a -> b
$ forall a. Chunk a -> Maybe a
unChunk Chunk a
a forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Chunk a -> Maybe a
unChunk Chunk a
b

instance Monad Chunk where
  return :: forall a. a -> Chunk a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Chunk a
m >>= :: forall a b. Chunk a -> (a -> Chunk b) -> Chunk b
>>= a -> Chunk b
f = forall a. Maybe a -> Chunk a
Chunk forall a b. (a -> b) -> a -> b
$ forall a. Chunk a -> Maybe a
unChunk Chunk a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Chunk a -> Maybe a
unChunk forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Chunk b
f

instance Semigroup a => Semigroup (Chunk a) where
  <> :: Chunk a -> Chunk a -> Chunk a
(<>) = forall a. (a -> a -> a) -> Chunk a -> Chunk a -> Chunk a
chunked forall a. Semigroup a => a -> a -> a
(<>)

instance Semigroup a => Monoid (Chunk a) where
  mempty :: Chunk a
mempty = forall a. Maybe a -> Chunk a
Chunk forall a. Maybe a
Nothing
  mappend :: Chunk a -> Chunk a -> Chunk a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

instance MonadPlus Chunk where
  mzero :: forall a. Chunk a
mzero = forall a. Maybe a -> Chunk a
Chunk forall (m :: * -> *) a. MonadPlus m => m a
mzero
  mplus :: forall a. Chunk a -> Chunk a -> Chunk a
mplus Chunk a
m1 Chunk a
m2 = forall a. Maybe a -> Chunk a
Chunk forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus (forall a. Chunk a -> Maybe a
unChunk Chunk a
m1) (forall a. Chunk a -> Maybe a
unChunk Chunk a
m2)

-- | Given a semigroup structure on 'a', return a monoid structure on 'Chunk a'.
--
-- Note that this is /not/ the same as 'liftA2'.
chunked :: (a -> a -> a)
        -> Chunk a -> Chunk a -> Chunk a
chunked :: forall a. (a -> a -> a) -> Chunk a -> Chunk a -> Chunk a
chunked a -> a -> a
_ (Chunk Maybe a
Nothing) Chunk a
y = Chunk a
y
chunked a -> a -> a
_ Chunk a
x (Chunk Maybe a
Nothing) = Chunk a
x
chunked a -> a -> a
f (Chunk (Just a
x)) (Chunk (Just a
y)) = forall a. Maybe a -> Chunk a
Chunk (forall a. a -> Maybe a
Just (a -> a -> a
f a
x a
y))

-- | Concatenate a list into a Chunk.  'listToChunk' satisfies:
--
-- > isEmpty . listToChunk = null
-- > listToChunk = mconcat . fmap pure
listToChunk :: Semigroup a => [a] -> Chunk a
listToChunk :: forall a. Semigroup a => [a] -> Chunk a
listToChunk [] = forall a. Monoid a => a
mempty
listToChunk (a
x:[a]
xs) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. Semigroup a => NonEmpty a -> a
sconcat (a
x forall a. a -> [a] -> NonEmpty a
:| [a]
xs))

-- | Part of a constrained comonad instance.
--
-- This is the counit of the adjunction between 'Chunk' and the forgetful
-- functor from monoids to semigroups.  It satisfies:
--
-- > extractChunk . pure = id
-- > extractChunk . fmap pure = id
extractChunk :: Monoid a => Chunk a -> a
extractChunk :: forall a. Monoid a => Chunk a -> a
extractChunk = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Chunk a -> Maybe a
unChunk
-- we could also define:
-- duplicate :: Monoid a => Chunk a -> Chunk (Chunk a)
-- duplicate = fmap pure

-- | Concatenate two 'Chunk's with a space in between.  If one is empty, this
-- just returns the other one.
--
-- Unlike '<+>' for 'Doc', this operation has a unit element, namely the empty
-- 'Chunk'.
(<<+>>) :: Chunk Doc -> Chunk Doc -> Chunk Doc
<<+>> :: Chunk Doc -> Chunk Doc -> Chunk Doc
(<<+>>) = forall a. (a -> a -> a) -> Chunk a -> Chunk a -> Chunk a
chunked Doc -> Doc -> Doc
(<+>)

-- | Concatenate two 'Chunk's with a softline in between.  This is exactly like
-- '<<+>>', but uses a softline instead of a space.
(<</>>) :: Chunk Doc -> Chunk Doc -> Chunk Doc
<</>> :: Chunk Doc -> Chunk Doc -> Chunk Doc
(<</>>) = forall a. (a -> a -> a) -> Chunk a -> Chunk a -> Chunk a
chunked Doc -> Doc -> Doc
(</>)

-- | Concatenate 'Chunk's vertically.
vcatChunks :: [Chunk Doc] -> Chunk Doc
vcatChunks :: [Chunk Doc] -> Chunk Doc
vcatChunks = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. (a -> a -> a) -> Chunk a -> Chunk a -> Chunk a
chunked Doc -> Doc -> Doc
(.$.)) forall a. Monoid a => a
mempty

-- | Concatenate 'Chunk's vertically separated by empty lines.
vsepChunks :: [Chunk Doc] -> Chunk Doc
vsepChunks :: [Chunk Doc] -> Chunk Doc
vsepChunks = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. (a -> a -> a) -> Chunk a -> Chunk a -> Chunk a
chunked (\Doc
x Doc
y -> Doc
x Doc -> Doc -> Doc
.$. forall a. Monoid a => a
mempty Doc -> Doc -> Doc
.$. Doc
y)) forall a. Monoid a => a
mempty

-- | Whether a 'Chunk' is empty.  Note that something like 'pure mempty' is not
-- considered an empty chunk, even though the underlying 'Doc' is empty.
isEmpty :: Chunk a -> Bool
isEmpty :: forall a. Chunk a -> Bool
isEmpty = forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Chunk a -> Maybe a
unChunk

-- | Convert a 'String' into a 'Chunk'.  This satisfies:
--
-- > isEmpty . stringChunk = null
-- > extractChunk . stringChunk = string
stringChunk :: String -> Chunk Doc
stringChunk :: String -> Chunk Doc
stringChunk String
"" = forall a. Monoid a => a
mempty
stringChunk String
s = forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Doc
string String
s)

-- | Convert a paragraph into a 'Chunk'.  The resulting chunk is composed by the
-- words of the original paragraph separated by softlines, so it will be
-- automatically word-wrapped when rendering the underlying document.
--
-- This satisfies:
--
-- > isEmpty . paragraph = null . words
paragraph :: String -> Chunk Doc
paragraph :: String -> Chunk Doc
paragraph = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. (a -> a -> a) -> Chunk a -> Chunk a -> Chunk a
chunked Doc -> Doc -> Doc
(</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Chunk Doc
stringChunk) forall a. Monoid a => a
mempty
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words

-- | Display pairs of strings in a table.
tabulate :: Int -> [(Doc, Doc)] -> Chunk Doc
tabulate :: Int -> [(Doc, Doc)] -> Chunk Doc
tabulate Int
_ [] = forall a. Monoid a => a
mempty
tabulate Int
size [(Doc, Doc)]
table = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
  [ Int -> Doc -> Doc
indent Int
2 (Int -> Doc -> Doc
fillBreak Int
size Doc
key Doc -> Doc -> Doc
<+> Doc
value)
  | (Doc
key, Doc
value) <- [(Doc, Doc)]
table ]