{-# LANGUAGE GADTs
           , OverloadedStrings #-}

module System.Console.Options.Help.Internal
  ( name
  , option
  , description
  ) where

import           Data.Console.Option
import           Data.List.NonEmpty (NonEmpty (..))
import qualified Data.Text as Text
import           Prettyprinter
import           Prettyprinter.Internal.Type



-- | Option name.
--
--   >>> putDocW 80 $ name (Short 'h')
--   -h
--   >>> putDocW 80 $ name (Long 'long-foo')
--   --long-foo
name :: Name -> Doc ann
name :: forall ann. Name -> Doc ann
name (Short Char
c) =  Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
c
name (Long Text
ls) = Doc ann
"--" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
ls



-- | Option together with the argument name, if applicable.
--
--   >>> putDocW 80 . option $ Option (Short 'f' :| [Long "foo"]) (plain id)
--   -f, --foo
--   >>> putDocW 80 . option $ Option (Long "bar" :| [Long "baz"]) (required "FILE" id)
--   --bar, --baz=FILE
option :: Option m (Doc ann) f -> Doc ann
option :: forall (m :: * -> *) ann f. Option m (Doc ann) f -> Doc ann
option (Option (Name
n :| [Name]
ns) Flavor m (Doc ann) f
f) =
  Name -> Doc ann
forall ann. Name -> Doc ann
name Name
n Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (Name -> Doc ann -> Doc ann) -> Doc ann -> [Name] -> Doc ann
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Name
a Doc ann
b -> Doc ann
forall ann. Doc ann
softline' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
", " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Name -> Doc ann
forall ann. Name -> Doc ann
name Name
a Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
b) (Flavor m (Doc ann) f -> Doc ann
forall {m :: * -> *} {ann} {f}. Flavor m (Doc ann) f -> Doc ann
flavor Flavor m (Doc ann) f
f) [Name]
ns
  where
    flavor :: Flavor m (Doc ann) f -> Doc ann
flavor (Plain        m f
_) = Doc ann
forall ann. Doc ann
emptyDoc
    flavor (Optional Doc ann
doc m (Maybe String -> f)
_) = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
doc)
    flavor (Required Doc ann
doc m (String -> f)
_) = Doc ann
forall ann. Doc ann
equals Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
doc



-- | Help description for a given option.
--
--   The help text is laid out at base indentation. Additionally the first line
--   of help text can shift based on the increment, in the case that the list
--   of option names is longer than base indentation.
--
--   >>> let opt = Option (Short 'f' :| [Long "foo", Long "tediously-long-bar", Long "baz"]) (Flavor (Required "FIL    E") id)
--   >>> let help = reflow "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor..."
--   >>> putDocW 80 $ description 32 8 opt help
--   -f, --foo, --tediously-long-bar, --baz=FILE     Lorem ipsum dolor sit amet,
--                                   consectetur adipiscing elit, sed do eiusmod
--                                   tempor...
description
  :: Int                  -- ^ Base help text indentation
  -> Int                  -- ^ Indentation increment
  -> Option m (Doc ann) f
  -> Doc ann              -- ^ Help text
  -> Doc ann
description :: forall (m :: * -> *) ann f.
Int -> Int -> Option m (Doc ann) f -> Doc ann -> Doc ann
description Int
offset Int
fracs opt :: Option m (Doc ann) f
opt@(Option (Name
first :| [Name]
_) Flavor m (Doc ann) f
_) Doc ann
doc =
  Doc ann -> (Int -> Doc ann) -> Doc ann
forall ann. Doc ann -> (Int -> Doc ann) -> Doc ann
width
    ( case Name
first of
        Short Char
_ ->           Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Option m (Doc ann) f -> Doc ann
forall (m :: * -> *) ann f. Option m (Doc ann) f -> Doc ann
option Option m (Doc ann) f
opt)
        Long Text
_  -> Doc ann
"    " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Option m (Doc ann) f -> Doc ann
forall (m :: * -> *) ann f. Option m (Doc ann) f -> Doc ann
option Option m (Doc ann) f
opt)
    )
    ( \Int
i ->
       Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
offset (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$
         let spaces :: Int
spaces
               | Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
offset = Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i
               | Bool
otherwise      = let r :: Int
r = (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`rem` Int
fracs

                                  in if Int
r Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
fracs
                                       then Int
fracs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
fracs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r)
                                       else Int
fracs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
r

         in Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
Union (Int -> Text -> Doc ann
forall ann. Int -> Text -> Doc ann
Text Int
spaces (Int -> Text -> Text
Text.replicate Int
spaces Text
" ")) Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
doc
    )