{-# Language BlockArguments #-}
{-# Language OverloadedStrings #-}
{-# Language RecordWildCards #-}
module Cryptol.REPL.Help (helpForNamed) where

import Data.Text (Text)
import qualified Data.Text as Text
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Maybe(fromMaybe)
import Data.List(intersperse)
import Control.Monad(when,guard,unless,msum,mplus)

import Cryptol.Utils.PP
import Cryptol.Utils.Ident(OrigName(..),identIsNormal)
import qualified Cryptol.Parser.AST as P
import qualified Cryptol.ModuleSystem as M
import qualified Cryptol.ModuleSystem.Name as M
import qualified Cryptol.ModuleSystem.NamingEnv as M
import qualified Cryptol.ModuleSystem.Env as M
import qualified Cryptol.ModuleSystem.Interface as M
import qualified Cryptol.ModuleSystem.Renamer.Error as M (ModKind(..))
import qualified Cryptol.TypeCheck.AST as T
import Cryptol.TypeCheck.PP(emptyNameMap,ppWithNames)

import Cryptol.REPL.Monad

helpForNamed :: P.PName -> REPL ()
helpForNamed :: PName -> REPL ()
helpForNamed PName
qname =
  do ModContext
fe <- REPL ModContext
getFocusedEnv
     let params :: ModContextParams
params = ModContext -> ModContextParams
M.mctxParams ModContext
fe
         env :: IfaceDecls
env    = ModContext -> IfaceDecls
M.mctxDecls  ModContext
fe
         rnEnv :: NamingEnv
rnEnv  = ModContext -> NamingEnv
M.mctxNames  ModContext
fe
         disp :: NameDisp
disp   = ModContext -> NameDisp
M.mctxNameDisp ModContext
fe

         vNames :: [Name]
vNames = Namespace -> PName -> NamingEnv -> [Name]
M.lookupListNS Namespace
M.NSValue  PName
qname NamingEnv
rnEnv
         tNames :: [Name]
tNames = Namespace -> PName -> NamingEnv -> [Name]
M.lookupListNS Namespace
M.NSType   PName
qname NamingEnv
rnEnv
         mNames :: [Name]
mNames = Namespace -> PName -> NamingEnv -> [Name]
M.lookupListNS Namespace
M.NSModule PName
qname NamingEnv
rnEnv

     let helps :: [REPL ()]
helps = forall a b. (a -> b) -> [a] -> [b]
map (ModContextParams -> IfaceDecls -> NameDisp -> Name -> REPL ()
showTypeHelp ModContextParams
params IfaceDecls
env NameDisp
disp) [Name]
tNames forall a. [a] -> [a] -> [a]
++
                 forall a b. (a -> b) -> [a] -> [b]
map (ModContextParams
-> IfaceDecls -> NameDisp -> PName -> Name -> REPL ()
showValHelp ModContextParams
params IfaceDecls
env NameDisp
disp PName
qname) [Name]
vNames forall a. [a] -> [a] -> [a]
++
                 forall a b. (a -> b) -> [a] -> [b]
map (IfaceDecls -> NameDisp -> Name -> REPL ()
showModHelp IfaceDecls
env NameDisp
disp) [Name]
mNames

         separ :: REPL ()
separ = [Char] -> REPL ()
rPutStrLn [Char]
"            ---------"
     forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (forall a. a -> [a] -> [a]
intersperse REPL ()
separ [REPL ()]
helps)

     forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Name]
vNames forall a. [a] -> [a] -> [a]
++ [Name]
tNames forall a. [a] -> [a] -> [a]
++ [Name]
mNames)) forall a b. (a -> b) -> a -> b
$
       forall a. Show a => a -> REPL ()
rPrint forall a b. (a -> b) -> a -> b
$ Doc
"Undefined name:" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp PName
qname


noInfo :: NameDisp -> M.Name -> REPL ()
noInfo :: NameDisp -> Name -> REPL ()
noInfo NameDisp
nameEnv Name
name =
  case Name -> NameInfo
M.nameInfo Name
name of
    M.GlobalName NameSource
_ OrigName
og ->
      forall a. Show a => a -> REPL ()
rPrint (NameDisp -> Doc -> Doc Void
runDoc NameDisp
nameEnv (Doc
"Name defined in module" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (OrigName -> ModPath
ogModule OrigName
og)))
    M.LocalName {} -> [Char] -> REPL ()
rPutStrLn [Char]
"// No documentation is available."


-- | Show help for something in the module namespace.
showModHelp :: M.IfaceDecls -> NameDisp -> M.Name -> REPL ()
showModHelp :: IfaceDecls -> NameDisp -> Name -> REPL ()
showModHelp IfaceDecls
env NameDisp
nameEnv Name
name =
  forall a. a -> Maybe a -> a
fromMaybe (NameDisp -> Name -> REPL ()
noInfo NameDisp
nameEnv Name
name) forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ forall a.
(IfaceDecls -> Map Name a)
-> (IfaceDecls -> NameDisp -> Name -> a -> REPL ())
-> Maybe (REPL ())
attempt IfaceDecls -> Map Name (IfaceNames Name)
M.ifModules IfaceDecls -> NameDisp -> Name -> IfaceNames Name -> REPL ()
showModuleHelp
         , forall a.
(IfaceDecls -> Map Name a)
-> (IfaceDecls -> NameDisp -> Name -> a -> REPL ())
-> Maybe (REPL ())
attempt IfaceDecls -> Map Name (IfaceG Name)
M.ifFunctors IfaceDecls -> NameDisp -> Name -> IfaceG Name -> REPL ()
showFunctorHelp
         , forall a.
(IfaceDecls -> Map Name a)
-> (IfaceDecls -> NameDisp -> Name -> a -> REPL ())
-> Maybe (REPL ())
attempt IfaceDecls -> Map Name ModParamNames
M.ifSignatures IfaceDecls -> NameDisp -> Name -> ModParamNames -> REPL ()
showSigHelp
         ]

  where
  attempt :: (M.IfaceDecls -> Map M.Name a) ->
             (M.IfaceDecls -> NameDisp -> M.Name -> a -> REPL ()) ->
             Maybe (REPL ())
  attempt :: forall a.
(IfaceDecls -> Map Name a)
-> (IfaceDecls -> NameDisp -> Name -> a -> REPL ())
-> Maybe (REPL ())
attempt IfaceDecls -> Map Name a
inMap IfaceDecls -> NameDisp -> Name -> a -> REPL ()
doShow =
    do a
th <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (IfaceDecls -> Map Name a
inMap IfaceDecls
env)
       forall (f :: * -> *) a. Applicative f => a -> f a
pure (IfaceDecls -> NameDisp -> Name -> a -> REPL ()
doShow IfaceDecls
env NameDisp
nameEnv Name
name a
th)

showModuleHelp ::
  M.IfaceDecls -> NameDisp -> M.Name -> M.IfaceNames M.Name -> REPL ()
showModuleHelp :: IfaceDecls -> NameDisp -> Name -> IfaceNames Name -> REPL ()
showModuleHelp IfaceDecls
env NameDisp
_nameEnv Name
name IfaceNames Name
info =
  ModKind -> Name -> Maybe Text -> ModSummary -> REPL ()
showSummary ModKind
M.AModule Name
name (forall name. IfaceNames name -> Maybe Text
M.ifsDoc IfaceNames Name
info) (IfaceDecls -> IfaceNames Name -> ModSummary
ifaceSummary IfaceDecls
env IfaceNames Name
info)

ifaceSummary :: M.IfaceDecls -> M.IfaceNames M.Name -> ModSummary
ifaceSummary :: IfaceDecls -> IfaceNames Name -> ModSummary
ifaceSummary IfaceDecls
env IfaceNames Name
info =
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Name -> ModSummary -> ModSummary
addName ModSummary
emptySummary (forall a. Set a -> [a]
Set.toList (forall name. IfaceNames name -> Set Name
M.ifsPublic IfaceNames Name
info))
  where
  addName :: Name -> ModSummary -> ModSummary
addName Name
x ModSummary
ns = forall a. a -> Maybe a -> a
fromMaybe ModSummary
ns
               forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ (Kind, Maybe Text) -> ModSummary
addT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [Maybe (Kind, Maybe Text)
fromTS, Maybe (Kind, Maybe Text)
fromNT, Maybe (Kind, Maybe Text)
fromAT]
                      , (Schema, Maybe Text, Maybe Fixity) -> ModSummary
addV forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Schema, Maybe Text, Maybe Fixity)
fromD
                      , (ModKind, Maybe Text) -> ModSummary
addM forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ Maybe (ModKind, Maybe Text)
fromM, Maybe (ModKind, Maybe Text)
fromS, Maybe (ModKind, Maybe Text)
fromF ]
                      ]
    where
    addT :: (Kind, Maybe Text) -> ModSummary
addT (Kind
k,Maybe Text
d) = ModSummary
ns { msTypes :: [ModTParam]
msTypes = T.ModTParam { mtpName :: Name
T.mtpName = Name
x
                                            , mtpKind :: Kind
T.mtpKind = Kind
k
                                            , mtpDoc :: Maybe Text
T.mtpDoc  = Maybe Text
d
                                            } forall a. a -> [a] -> [a]
: ModSummary -> [ModTParam]
msTypes ModSummary
ns }

    addV :: (Schema, Maybe Text, Maybe Fixity) -> ModSummary
addV (Schema
t,Maybe Text
d,Maybe Fixity
f) = ModSummary
ns { msVals :: [ModVParam]
msVals = T.ModVParam { mvpName :: Name
T.mvpName = Name
x
                                             , mvpType :: Schema
T.mvpType = Schema
t
                                             , mvpDoc :: Maybe Text
T.mvpDoc  = Maybe Text
d
                                             , mvpFixity :: Maybe Fixity
T.mvpFixity = Maybe Fixity
f
                                             } forall a. a -> [a] -> [a]
: ModSummary -> [ModVParam]
msVals ModSummary
ns }

    addM :: (ModKind, Maybe Text) -> ModSummary
addM (ModKind
k,Maybe Text
d)= ModSummary
ns { msMods :: [(Name, ModKind, Maybe Text)]
msMods = (Name
x, ModKind
k, Maybe Text
d) forall a. a -> [a] -> [a]
: ModSummary -> [(Name, ModKind, Maybe Text)]
msMods ModSummary
ns }


    fromTS :: Maybe (Kind, Maybe Text)
fromTS = do TySyn
def <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name TySyn
M.ifTySyns IfaceDecls
env)
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall t. HasKind t => t -> Kind
T.kindOf TySyn
def, TySyn -> Maybe Text
T.tsDoc TySyn
def)

    fromNT :: Maybe (Kind, Maybe Text)
fromNT = do Newtype
def <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name Newtype
M.ifNewtypes IfaceDecls
env)
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall t. HasKind t => t -> Kind
T.kindOf Newtype
def, Newtype -> Maybe Text
T.ntDoc Newtype
def)

    fromAT :: Maybe (Kind, Maybe Text)
fromAT = do AbstractType
def <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name AbstractType
M.ifAbstractTypes IfaceDecls
env)
                forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall t. HasKind t => t -> Kind
T.kindOf AbstractType
def, AbstractType -> Maybe Text
T.atDoc AbstractType
def)

    fromD :: Maybe (Schema, Maybe Text, Maybe Fixity)
fromD = do IfaceDecl
def <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name IfaceDecl
M.ifDecls IfaceDecls
env)
               forall (f :: * -> *) a. Applicative f => a -> f a
pure (IfaceDecl -> Schema
M.ifDeclSig IfaceDecl
def, IfaceDecl -> Maybe Text
M.ifDeclDoc IfaceDecl
def, IfaceDecl -> Maybe Fixity
M.ifDeclFixity IfaceDecl
def)

    fromM :: Maybe (ModKind, Maybe Text)
fromM = do IfaceNames Name
def <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name (IfaceNames Name)
M.ifModules IfaceDecls
env)
               forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModKind
M.AModule, forall name. IfaceNames name -> Maybe Text
M.ifsDoc IfaceNames Name
def)

    fromF :: Maybe (ModKind, Maybe Text)
fromF = do IfaceG Name
def <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name (IfaceG Name)
M.ifFunctors IfaceDecls
env)
               forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModKind
M.AFunctor, forall name. IfaceNames name -> Maybe Text
M.ifsDoc (forall name. IfaceG name -> IfaceNames name
M.ifNames IfaceG Name
def))

    fromS :: Maybe (ModKind, Maybe Text)
fromS = do ModParamNames
def <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name ModParamNames
M.ifSignatures IfaceDecls
env)
               forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModKind
M.ASignature, ModParamNames -> Maybe Text
T.mpnDoc ModParamNames
def)



showFunctorHelp ::
  M.IfaceDecls -> NameDisp -> M.Name -> M.IfaceG M.Name -> REPL ()
showFunctorHelp :: IfaceDecls -> NameDisp -> Name -> IfaceG Name -> REPL ()
showFunctorHelp IfaceDecls
_env NameDisp
_nameEnv Name
name IfaceG Name
info =
  ModKind -> Name -> Maybe Text -> ModSummary -> REPL ()
showSummary ModKind
M.AFunctor Name
name (forall name. IfaceNames name -> Maybe Text
M.ifsDoc IfaceNames Name
ns) ModSummary
summary
  where
  ns :: IfaceNames Name
ns      = forall name. IfaceG name -> IfaceNames name
M.ifNames IfaceG Name
info
  summary :: ModSummary
summary = (IfaceDecls -> IfaceNames Name -> ModSummary
ifaceSummary (forall name. IfaceG name -> IfaceDecls
M.ifDefines IfaceG Name
info) IfaceNames Name
ns)
                { msParams :: [(Ident, ImpName Name)]
msParams = [ (ModParam -> Ident
T.mpName ModParam
p, ModParam -> ImpName Name
T.mpIface ModParam
p)
                             | ModParam
p <- forall k a. Map k a -> [a]
Map.elems (forall name. IfaceG name -> FunctorParams
M.ifParams IfaceG Name
info)
                             ]
                }


showSigHelp ::
  M.IfaceDecls -> NameDisp -> M.Name -> T.ModParamNames -> REPL ()
showSigHelp :: IfaceDecls -> NameDisp -> Name -> ModParamNames -> REPL ()
showSigHelp IfaceDecls
_env NameDisp
_nameEnv Name
name ModParamNames
info =
  ModKind -> Name -> Maybe Text -> ModSummary -> REPL ()
showSummary ModKind
M.ASignature Name
name (ModParamNames -> Maybe Text
T.mpnDoc ModParamNames
info)
    ModSummary
emptySummary
      { msTypes :: [ModTParam]
msTypes = forall k a. Map k a -> [a]
Map.elems (ModParamNames -> Map Name ModTParam
T.mpnTypes ModParamNames
info)
      , msVals :: [ModVParam]
msVals  = forall k a. Map k a -> [a]
Map.elems (ModParamNames -> Map Name ModVParam
T.mpnFuns ModParamNames
info)
      , msConstraints :: [Prop]
msConstraints = forall a b. (a -> b) -> [a] -> [b]
map forall a. Located a -> a
P.thing (ModParamNames -> [Located Prop]
T.mpnConstraints ModParamNames
info)
      }

--------------------------------------------------------------------------------
data ModSummary = ModSummary
  { ModSummary -> [(Ident, ImpName Name)]
msParams      :: [(P.Ident, P.ImpName M.Name)]
  , ModSummary -> [Prop]
msConstraints :: [T.Prop]
  , ModSummary -> [ModTParam]
msTypes       :: [T.ModTParam]
  , ModSummary -> [ModVParam]
msVals        :: [T.ModVParam]
  , ModSummary -> [(Name, ModKind, Maybe Text)]
msMods        :: [ (M.Name, M.ModKind, Maybe Text) ]
  }

emptySummary :: ModSummary
emptySummary :: ModSummary
emptySummary = ModSummary
  { msParams :: [(Ident, ImpName Name)]
msParams      = []
  , msConstraints :: [Prop]
msConstraints = []
  , msTypes :: [ModTParam]
msTypes       = []
  , msVals :: [ModVParam]
msVals        = []
  , msMods :: [(Name, ModKind, Maybe Text)]
msMods        = []
  }

showSummary :: M.ModKind -> M.Name -> Maybe Text -> ModSummary -> REPL ()
showSummary :: ModKind -> Name -> Maybe Text -> ModSummary -> REPL ()
showSummary ModKind
k Name
name Maybe Text
doc ModSummary
info =
  do [Char] -> REPL ()
rPutStrLn [Char]
""

     forall a. Show a => a -> REPL ()
rPrint forall a b. (a -> b) -> a -> b
$ NameDisp -> Doc -> Doc Void
runDoc NameDisp
disp
        case ModKind
k of
          ModKind
M.AModule    ->
            [Doc] -> Doc
vcat [ Doc
"Module" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp Name
name Doc -> Doc -> Doc
<+> Doc
"exports:"
                 , Int -> Doc -> Doc
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [ Doc
ppTPs, Doc
ppFPs ]
                 ]
          ModKind
M.ASignature ->
            [Doc] -> Doc
vcat [ Doc
"Interface" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp Name
name Doc -> Doc -> Doc
<+> Doc
"requires:"
                 , Int -> Doc -> Doc
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [ Doc
ppTPs, Doc
ppCtrs, Doc
ppFPs ]
                 ]
          ModKind
M.AFunctor ->
            [Doc] -> Doc
vcat [ Doc
"Parameterized module" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp Name
name Doc -> Doc -> Doc
<+> Doc
"requires:"
                 , Int -> Doc -> Doc
indent Int
2 forall a b. (a -> b) -> a -> b
$ Doc
ppPs
                 , Doc
" ", Doc
"and exports:"
                 , Int -> Doc -> Doc
indent Int
2 forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat [ Doc
ppTPs, Doc
ppFPs ]
                 ]

     Maybe Text -> REPL ()
doShowDocString Maybe Text
doc

  where
  -- qualifying stuff is too noisy
  disp :: NameDisp
disp        = (OrigName -> Maybe NameFormat) -> NameDisp
NameDisp \OrigName
_ -> forall a. a -> Maybe a
Just NameFormat
UnQualified

  withMaybeNest :: Maybe Doc -> Doc -> Doc
withMaybeNest Maybe Doc
mb Doc
x =
    case Maybe Doc
mb of
      Maybe Doc
Nothing -> Doc
x
      Just Doc
d  -> [Doc] -> Doc
vcat [Doc
x, Int -> Doc -> Doc
indent Int
2 Doc
d]

  withDoc :: Maybe a -> Doc -> Doc
withDoc Maybe a
mb = Maybe Doc -> Doc -> Doc
withMaybeNest (forall a. PP a => a -> Doc
pp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
mb)
  withFix :: Maybe Fixity -> Doc -> Doc
withFix Maybe Fixity
mb = Maybe Doc -> Doc -> Doc
withMaybeNest ([Char] -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixity -> [Char]
ppFixity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Fixity
mb)
  ppMany :: [Doc] -> Doc
ppMany [Doc]
xs  = case [Doc]
xs of
                 [] -> forall a. Monoid a => a
mempty
                 [Doc]
_  -> [Doc] -> Doc
vcat (Doc
" " forall a. a -> [a] -> [a]
: [Doc]
xs)

  ppPs :: Doc
ppPs = [Doc] -> Doc
ppMany (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. PP a => (Ident, a) -> Doc
ppP (ModSummary -> [(Ident, ImpName Name)]
msParams ModSummary
info))
  ppP :: (Ident, a) -> Doc
ppP (Ident
x,a
y)
    | Ident -> Bool
identIsNormal Ident
x = forall a. PP a => a -> Doc
pp Ident
x Doc -> Doc -> Doc
<+> Doc
": interface" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp a
y
    | Bool
otherwise = Doc
"(anonymous parameter)"


  ppTPs :: Doc
ppTPs  = [Doc] -> Doc
ppMany (forall a b. (a -> b) -> [a] -> [b]
map ModTParam -> Doc
ppTP (ModSummary -> [ModTParam]
msTypes ModSummary
info))
  ppTP :: ModTParam -> Doc
ppTP ModTParam
x = forall {a}. PP a => Maybe a -> Doc -> Doc
withDoc (ModTParam -> Maybe Text
T.mtpDoc ModTParam
x)
         forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [Doc
"type", forall a. PP a => a -> Doc
pp (ModTParam -> Name
T.mtpName ModTParam
x), Doc
":", forall a. PP a => a -> Doc
pp (ModTParam -> Kind
T.mtpKind ModTParam
x)]

  ppCtrs :: Doc
ppCtrs = [Doc] -> Doc
ppMany (forall a b. (a -> b) -> [a] -> [b]
map forall a. PP a => a -> Doc
pp (ModSummary -> [Prop]
msConstraints ModSummary
info))

  ppFPs :: Doc
ppFPs  = [Doc] -> Doc
ppMany (forall a b. (a -> b) -> [a] -> [b]
map ModVParam -> Doc
ppFP (ModSummary -> [ModVParam]
msVals ModSummary
info))
  ppFP :: ModVParam -> Doc
ppFP ModVParam
x = Maybe Fixity -> Doc -> Doc
withFix (ModVParam -> Maybe Fixity
T.mvpFixity ModVParam
x)
         forall a b. (a -> b) -> a -> b
$ forall {a}. PP a => Maybe a -> Doc -> Doc
withDoc (ModVParam -> Maybe Text
T.mvpDoc ModVParam
x)
         forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [forall a. PP a => a -> Doc
pp (ModVParam -> Name
T.mvpName ModVParam
x), Doc
":" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (ModVParam -> Schema
T.mvpType ModVParam
x) ]
--------------------------------------------------------------------------------




showTypeHelp ::
  M.ModContextParams -> M.IfaceDecls -> NameDisp -> T.Name -> REPL ()
showTypeHelp :: ModContextParams -> IfaceDecls -> NameDisp -> Name -> REPL ()
showTypeHelp ModContextParams
ctxparams IfaceDecls
env NameDisp
nameEnv Name
name =
  forall a. a -> Maybe a -> a
fromMaybe (NameDisp -> Name -> REPL ()
noInfo NameDisp
nameEnv Name
name) forall a b. (a -> b) -> a -> b
$
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ Maybe (REPL ())
fromTySyn, Maybe (REPL ())
fromPrimType, Maybe (REPL ())
fromNewtype, Maybe (REPL ())
fromTyParam ]

  where
  fromTySyn :: Maybe (REPL ())
fromTySyn =
    do TySyn
ts <- forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (IfaceDecls -> Map Name TySyn
M.ifTySyns IfaceDecls
env)
                  , forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name
                      (ModParamNames -> Map Name TySyn
T.mpnTySyn (ModContextParams -> ModParamNames
M.modContextParamNames ModContextParams
ctxparams))
                  ]
       forall (m :: * -> *) a. Monad m => a -> m a
return (NameDisp -> Doc -> Maybe Text -> REPL ()
doShowTyHelp NameDisp
nameEnv (forall a. PP a => a -> Doc
pp TySyn
ts) (TySyn -> Maybe Text
T.tsDoc TySyn
ts))

  fromNewtype :: Maybe (REPL ())
fromNewtype =
    do Newtype
nt <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (IfaceDecls -> Map Name Newtype
M.ifNewtypes IfaceDecls
env)
       let decl :: Doc
decl = forall a. PP a => a -> Doc
pp Newtype
nt Doc -> Doc -> Doc
$$ (forall a. PP a => a -> Doc
pp Name
name Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
":" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (Newtype -> Schema
T.newtypeConType Newtype
nt))
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NameDisp -> Doc -> Maybe Text -> REPL ()
doShowTyHelp NameDisp
nameEnv Doc
decl (Newtype -> Maybe Text
T.ntDoc Newtype
nt)

  fromPrimType :: Maybe (REPL ())
fromPrimType =
    do AbstractType
a <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (IfaceDecls -> Map Name AbstractType
M.ifAbstractTypes IfaceDecls
env)
       forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ do [Char] -> REPL ()
rPutStrLn [Char]
""
                 forall a. Show a => a -> REPL ()
rPrint forall a b. (a -> b) -> a -> b
$ NameDisp -> Doc -> Doc Void
runDoc NameDisp
nameEnv forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
4
                        forall a b. (a -> b) -> a -> b
$ Doc
"primitive type" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (AbstractType -> Name
T.atName AbstractType
a)
                                   Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (AbstractType -> Kind
T.atKind AbstractType
a)

                 let ([TParam]
vs,[Prop]
cs) = AbstractType -> ([TParam], [Prop])
T.atCtrs AbstractType
a
                 forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Prop]
cs) forall a b. (a -> b) -> a -> b
$
                   do let example :: Prop
example = TCon -> [Prop] -> Prop
T.TCon (AbstractType -> TCon
T.abstractTypeTC AbstractType
a)
                                           (forall a b. (a -> b) -> [a] -> [b]
map (TVar -> Prop
T.TVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. TParam -> TVar
T.tpVar) [TParam]
vs)
                          ns :: NameMap
ns = [TParam] -> NameMap -> NameMap
T.addTNames [TParam]
vs NameMap
emptyNameMap
                          rs :: [Doc]
rs = [ Doc
"•" Doc -> Doc -> Doc
<+> forall a. PP (WithNames a) => NameMap -> a -> Doc
ppWithNames NameMap
ns Prop
c | Prop
c <- [Prop]
cs ]
                      [Char] -> REPL ()
rPutStrLn [Char]
""
                      forall a. Show a => a -> REPL ()
rPrint forall a b. (a -> b) -> a -> b
$ NameDisp -> Doc -> Doc Void
runDoc NameDisp
nameEnv forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
indent Int
4 forall a b. (a -> b) -> a -> b
$
                                  Doc -> Doc
backticks (forall a. PP (WithNames a) => NameMap -> a -> Doc
ppWithNames NameMap
ns Prop
example) Doc -> Doc -> Doc
<+>
                                  Doc
"requires:" Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
indent Int
2 ([Doc] -> Doc
vcat [Doc]
rs)

                 Maybe Fixity -> REPL ()
doShowFix (AbstractType -> Maybe Fixity
T.atFixitiy AbstractType
a)
                 Maybe Text -> REPL ()
doShowDocString (AbstractType -> Maybe Text
T.atDoc AbstractType
a)

  allParamNames :: Map Name (Maybe Ident, ModTParam)
allParamNames =
    case ModContextParams
ctxparams of
      ModContextParams
M.NoParams -> forall a. Monoid a => a
mempty
      M.FunctorParams FunctorParams
fparams ->
        forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
          [ (\ModTParam
x -> (forall a. a -> Maybe a
Just Ident
p,ModTParam
x)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModParamNames -> Map Name ModTParam
T.mpnTypes (ModParam -> ModParamNames
T.mpParameters ModParam
ps)
          | (Ident
p, ModParam
ps) <- forall k a. Map k a -> [(k, a)]
Map.toList FunctorParams
fparams
          ]
      M.InterfaceParams ModParamNames
ps -> (\ModTParam
x -> (forall a. Maybe a
Nothing ,ModTParam
x)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModParamNames -> Map Name ModTParam
T.mpnTypes ModParamNames
ps

  fromTyParam :: Maybe (REPL ())
fromTyParam =
    do (Maybe Ident
x,ModTParam
p) <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name (Maybe Ident, ModTParam)
allParamNames
       forall (f :: * -> *) a. Applicative f => a -> f a
pure do [Char] -> REPL ()
rPutStrLn [Char]
""
               case Maybe Ident
x of
                  Just Ident
src -> Ident -> REPL ()
doShowParameterSource Ident
src
                  Maybe Ident
Nothing  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
               let ty :: Doc
ty = Doc
"type" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp Name
name Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (ModTParam -> Kind
T.mtpKind ModTParam
p)
               forall a. Show a => a -> REPL ()
rPrint (NameDisp -> Doc -> Doc Void
runDoc NameDisp
nameEnv (Int -> Doc -> Doc
indent Int
4 Doc
ty))
               Maybe Text -> REPL ()
doShowDocString (ModTParam -> Maybe Text
T.mtpDoc ModTParam
p)


doShowTyHelp :: NameDisp -> Doc -> Maybe Text -> REPL ()
doShowTyHelp :: NameDisp -> Doc -> Maybe Text -> REPL ()
doShowTyHelp NameDisp
nameEnv Doc
decl Maybe Text
doc =
  do [Char] -> REPL ()
rPutStrLn [Char]
""
     forall a. Show a => a -> REPL ()
rPrint (NameDisp -> Doc -> Doc Void
runDoc NameDisp
nameEnv (Int -> Doc -> Doc
nest Int
4 Doc
decl))
     Maybe Text -> REPL ()
doShowDocString Maybe Text
doc



showValHelp ::
  M.ModContextParams -> M.IfaceDecls -> NameDisp -> P.PName -> T.Name -> REPL ()

showValHelp :: ModContextParams
-> IfaceDecls -> NameDisp -> PName -> Name -> REPL ()
showValHelp ModContextParams
ctxparams IfaceDecls
env NameDisp
nameEnv PName
qname Name
name =
  forall a. a -> Maybe a -> a
fromMaybe (NameDisp -> Name -> REPL ()
noInfo NameDisp
nameEnv Name
name)
            (forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ Maybe (REPL ())
fromDecl, Maybe (REPL ())
fromNewtype, Maybe (REPL ())
fromParameter ])
  where
  fromDecl :: Maybe (REPL ())
fromDecl =
    do M.IfaceDecl { Bool
[Pragma]
Maybe Text
Maybe Fixity
Name
Schema
ifDeclInfix :: IfaceDecl -> Bool
ifDeclPragmas :: IfaceDecl -> [Pragma]
ifDeclIsPrim :: IfaceDecl -> Bool
ifDeclName :: IfaceDecl -> Name
ifDeclDoc :: Maybe Text
ifDeclFixity :: Maybe Fixity
ifDeclInfix :: Bool
ifDeclPragmas :: [Pragma]
ifDeclIsPrim :: Bool
ifDeclSig :: Schema
ifDeclName :: Name
ifDeclFixity :: IfaceDecl -> Maybe Fixity
ifDeclDoc :: IfaceDecl -> Maybe Text
ifDeclSig :: IfaceDecl -> Schema
.. } <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (IfaceDecls -> Map Name IfaceDecl
M.ifDecls IfaceDecls
env)
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
         do [Char] -> REPL ()
rPutStrLn [Char]
""

            let property :: [Doc]
property 
                  | Pragma
P.PragmaProperty forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Pragma]
ifDeclPragmas = [[Char] -> Doc
text [Char]
"property"]
                  | Bool
otherwise                             = []
            forall a. Show a => a -> REPL ()
rPrint forall a b. (a -> b) -> a -> b
$ NameDisp -> Doc -> Doc Void
runDoc NameDisp
nameEnv
                   forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
indent Int
4
                   forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep

                   forall a b. (a -> b) -> a -> b
$ [Doc]
property forall a. [a] -> [a] -> [a]
++ [forall a. PP a => a -> Doc
pp PName
qname, Doc
colon, forall a. PP a => a -> Doc
pp (Schema
ifDeclSig)]

            Maybe Fixity -> REPL ()
doShowFix forall a b. (a -> b) -> a -> b
$ Maybe Fixity
ifDeclFixity forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                        (forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
ifDeclInfix forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Fixity
P.defaultFixity)

            Maybe Text -> REPL ()
doShowDocString Maybe Text
ifDeclDoc

  fromNewtype :: Maybe (REPL ())
fromNewtype =
    do Newtype
_ <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (IfaceDecls -> Map Name Newtype
M.ifNewtypes IfaceDecls
env)
       forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()

  allParamNames :: Map Name (Maybe Ident, ModVParam)
allParamNames =
    case ModContextParams
ctxparams of
      ModContextParams
M.NoParams -> forall a. Monoid a => a
mempty
      M.FunctorParams FunctorParams
fparams ->
        forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
          [ (\ModVParam
x -> (forall a. a -> Maybe a
Just Ident
p,ModVParam
x)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModParamNames -> Map Name ModVParam
T.mpnFuns (ModParam -> ModParamNames
T.mpParameters ModParam
ps)
          | (Ident
p, ModParam
ps) <- forall k a. Map k a -> [(k, a)]
Map.toList FunctorParams
fparams
          ]
      M.InterfaceParams ModParamNames
ps -> (\ModVParam
x -> (forall a. Maybe a
Nothing,ModVParam
x)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ModParamNames -> Map Name ModVParam
T.mpnFuns ModParamNames
ps

  fromParameter :: Maybe (REPL ())
fromParameter =
    do (Maybe Ident
x,ModVParam
p) <- forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name (Maybe Ident, ModVParam)
allParamNames
       forall (f :: * -> *) a. Applicative f => a -> f a
pure do [Char] -> REPL ()
rPutStrLn [Char]
""
               case Maybe Ident
x of
                 Just Ident
src -> Ident -> REPL ()
doShowParameterSource Ident
src
                 Maybe Ident
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
               let ty :: Doc
ty = forall a. PP a => a -> Doc
pp Name
name Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> forall a. PP a => a -> Doc
pp (ModVParam -> Schema
T.mvpType ModVParam
p)
               forall a. Show a => a -> REPL ()
rPrint (NameDisp -> Doc -> Doc Void
runDoc NameDisp
nameEnv (Int -> Doc -> Doc
indent Int
4 Doc
ty))
               Maybe Fixity -> REPL ()
doShowFix (ModVParam -> Maybe Fixity
T.mvpFixity ModVParam
p)
               Maybe Text -> REPL ()
doShowDocString (ModVParam -> Maybe Text
T.mvpDoc ModVParam
p)


doShowParameterSource :: P.Ident -> REPL ()
doShowParameterSource :: Ident -> REPL ()
doShowParameterSource Ident
i =
  do [Char] -> REPL ()
rPutStrLn (Text -> [Char]
Text.unpack Text
msg)
     [Char] -> REPL ()
rPutStrLn [Char]
""
  where
  msg :: Text
msg
    | Ident -> Bool
identIsNormal Ident
i = Text
"Provided by module parameter " forall a. Semigroup a => a -> a -> a
<> Ident -> Text
P.identText Ident
i forall a. Semigroup a => a -> a -> a
<> Text
"."
    | Bool
otherwise       = Text
"Provided by `parameters` declaration."


doShowDocString :: Maybe Text -> REPL ()
doShowDocString :: Maybe Text -> REPL ()
doShowDocString Maybe Text
doc =
  case Maybe Text
doc of
    Maybe Text
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just Text
d  -> [Char] -> REPL ()
rPutStrLn (Char
'\n' forall a. a -> [a] -> [a]
: Text -> [Char]
Text.unpack Text
d)

ppFixity :: T.Fixity -> String
ppFixity :: Fixity -> [Char]
ppFixity Fixity
f = [Char]
"Precedence " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Fixity -> Int
P.fLevel Fixity
f) forall a. [a] -> [a] -> [a]
++ [Char]
", " forall a. [a] -> [a] -> [a]
++
               case Fixity -> Assoc
P.fAssoc Fixity
f of
                 Assoc
P.LeftAssoc   -> [Char]
"associates to the left."
                 Assoc
P.RightAssoc  -> [Char]
"associates to the right."
                 Assoc
P.NonAssoc    -> [Char]
"does not associate."

doShowFix :: Maybe T.Fixity -> REPL ()
doShowFix :: Maybe Fixity -> REPL ()
doShowFix Maybe Fixity
fx =
  case Maybe Fixity
fx of
    Just Fixity
f  -> [Char] -> REPL ()
rPutStrLn (Char
'\n' forall a. a -> [a] -> [a]
: Fixity -> [Char]
ppFixity Fixity
f)
    Maybe Fixity
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()