Types.hs

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}

module UI.Butcher.Applicative.Types where



#include "prelude.inc"
import           Control.Applicative.Free
import qualified Control.Monad.Trans.MultiState.Strict
                                               as MultiStateS

-- import qualified Lens.Micro.TH                 as LensTH

import qualified Text.PrettyPrint              as PP



-- | Butcher supports two input modi: @String@ and @[String]@. Program
-- arguments have the latter form, while parsing interactive command input
-- (e.g. when you implement a terminal of sorts) is easier when you can
-- process the full @String@ without having to wordify it first by some
-- means (and List.words is not the right approach in many situations.)
data Input = InputString String | InputArgs [String]
  deriving (Show, Eq)

-- | Information about an error that occured when trying to parse some @Input@
-- using some @CmdParser@.
data ParsingError = ParsingError
  { _pe_messages  :: [String]
  , _pe_remaining :: Input
  }
  deriving (Show, Eq)

-- | Specifies whether we accept 0-1 or 0-n for @CmdParserPart@s.
data ManyUpperBound
  = ManyUpperBound1
  | ManyUpperBoundN

data Visibility = Visible | Hidden
  deriving (Show, Eq)


data CmdParserF out a
  = CmdParserHelp PP.Doc a
  | CmdParserSynopsis String a
  -- | CmdParserPeekDesc (CommandDesc () -> a)
  | CmdParserPeekInput (String -> a)
  -- TODO: we can clean up this duplication by providing
  -- a function (String -> Maybe (p, String)) -> (Input -> Maybe (p, Input)).
  | forall p . Typeable p => CmdParserPart
                               PartDesc
                               (String -> Maybe (p, String))
                               (p -> a)
  | forall p . Typeable p => CmdParserPartMany
                               ManyUpperBound PartDesc
                               (String -> Maybe (p, String))
                               ([p] -> a)
  | forall p . Typeable p => CmdParserPartInp
                               PartDesc
                               (Input -> Maybe (p, Input))
                               (p -> a)
  | forall p . Typeable p => CmdParserPartManyInp
                               ManyUpperBound
                               PartDesc
                               (Input -> Maybe (p, Input))
                               ([p] -> a)
  | CmdParserChild String (CmdParser out out) a
  | CmdParserReorderStart                    a
  | CmdParserReorderStop                     a
  -- | CmdParserGrouped String                  a
  -- | CmdParserGroupEnd                        a

type CmdParser out = Ap (CmdParserF out)

---------

-- | A representation/description of a command parser built via the
-- 'CmdParser' monad. Can be transformed into a pretty Doc to display
-- as usage/help via 'UI.Butcher.Monadic.Pretty.ppUsage' and related functions.
--
-- Note that there is the '_cmd_out' accessor that contains @Maybe out@ which
-- might be useful after successful parsing.
data CommandDesc = CommandDesc
  { _cmd_mParent    :: Maybe (Maybe String, CommandDesc)
  , _cmd_synopsis   :: Maybe PP.Doc
  , _cmd_help       :: Maybe PP.Doc
  , _cmd_parts      :: [PartDesc]
  , _cmd_children   :: [(String, CommandDesc)]
  , _cmd_visibility :: Visibility
  }
  deriving Show

-- type PartSeqDesc = [PartDesc]

-- | A representation/description of a command's parts, i.e. flags or params.
-- As a butcher user, the higher-level pretty-printing functions for
-- 'CommandDesc' are probably sufficient.
data PartDesc
  = PartLiteral String -- expect a literal string, like "--dry-run"
  | PartVariable String -- expect some user-provided input. The
                               -- string represents the name for the variable
                               -- used in the documentation, e.g. "FILE"
  | PartOptional PartDesc
  | PartAlts [PartDesc]
  | PartSeq [PartDesc]
  | PartDefault String -- default representation
                PartDesc
  | PartSuggestion [CompletionItem] PartDesc
  | PartRedirect String -- name for the redirection
                 PartDesc
  | PartReorder [PartDesc]
  | PartMany PartDesc
  | PartWithHelp PP.Doc PartDesc
  | PartHidden PartDesc
  deriving Show

data CompletionItem
  = CompletionString String
  | CompletionDirectory
  | CompletionFile
  deriving Show

data Cover
  = Bare
  | Wrap

type family Wear cover f a where
  Wear 'Bare Identity a = a
  Wear 'Wrap f        a = f a

class Covered c where
  wrap   :: c 'Bare Identity -> c 'Wrap Identity
  unwrap :: c 'Wrap Identity -> c 'Bare Identity

class CTraversable ctx c where
  cTraverse :: Proxy ctx -> (forall a . ctx a => f a -> m (g a)) -> c f -> m (c g)