{-# 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 = (Name -> REPL ()) -> [Name] -> [REPL ()]
forall a b. (a -> b) -> [a] -> [b]
map (ModContextParams -> IfaceDecls -> NameDisp -> Name -> REPL ()
showTypeHelp ModContextParams
params IfaceDecls
env NameDisp
disp) [Name]
tNames [REPL ()] -> [REPL ()] -> [REPL ()]
forall a. [a] -> [a] -> [a]
++
                 (Name -> REPL ()) -> [Name] -> [REPL ()]
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 [REPL ()] -> [REPL ()] -> [REPL ()]
forall a. [a] -> [a] -> [a]
++
                 (Name -> REPL ()) -> [Name] -> [REPL ()]
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]
"            ---------"
     [REPL ()] -> REPL ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (REPL () -> [REPL ()] -> [REPL ()]
forall a. a -> [a] -> [a]
intersperse REPL ()
separ [REPL ()]
helps)

     Bool -> REPL () -> REPL ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Name]
vNames [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
tNames [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
mNames)) (REPL () -> REPL ()) -> REPL () -> REPL ()
forall a b. (a -> b) -> a -> b
$
       Doc -> REPL ()
forall a. Show a => a -> REPL ()
rPrint (Doc -> REPL ()) -> Doc -> REPL ()
forall a b. (a -> b) -> a -> b
$ Doc
"Undefined name:" Doc -> Doc -> Doc
<+> PName -> 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 ->
      Doc Void -> REPL ()
forall a. Show a => a -> REPL ()
rPrint (NameDisp -> Doc -> Doc Void
runDoc NameDisp
nameEnv (Doc
"Name defined in module" Doc -> Doc -> Doc
<+> ModPath -> 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 =
  REPL () -> Maybe (REPL ()) -> REPL ()
forall a. a -> Maybe a -> a
fromMaybe (NameDisp -> Name -> REPL ()
noInfo NameDisp
nameEnv Name
name) (Maybe (REPL ()) -> REPL ()) -> Maybe (REPL ()) -> REPL ()
forall a b. (a -> b) -> a -> b
$
    [Maybe (REPL ())] -> Maybe (REPL ())
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ (IfaceDecls -> Map Name (IfaceNames Name))
-> (IfaceDecls -> NameDisp -> Name -> IfaceNames Name -> REPL ())
-> Maybe (REPL ())
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
         , (IfaceDecls -> Map Name (IfaceG Name))
-> (IfaceDecls -> NameDisp -> Name -> IfaceG Name -> REPL ())
-> Maybe (REPL ())
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
         , (IfaceDecls -> Map Name ModParamNames)
-> (IfaceDecls -> NameDisp -> Name -> ModParamNames -> REPL ())
-> Maybe (REPL ())
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 <- Name -> Map Name a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (IfaceDecls -> Map Name a
inMap IfaceDecls
env)
       REPL () -> Maybe (REPL ())
forall a. a -> Maybe a
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 (IfaceNames Name -> Maybe Text
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 =
    (Name -> ModSummary -> ModSummary)
-> ModSummary -> [Name] -> ModSummary
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Name -> ModSummary -> ModSummary
addName ModSummary
emptySummary (Set Name -> [Name]
forall a. Set a -> [a]
Set.toList (IfaceNames Name -> Set Name
forall name. IfaceNames name -> Set Name
M.ifsPublic IfaceNames Name
info))
  where
  addName :: Name -> ModSummary -> ModSummary
addName Name
x ModSummary
ns = ModSummary -> Maybe ModSummary -> ModSummary
forall a. a -> Maybe a -> a
fromMaybe ModSummary
ns
               (Maybe ModSummary -> ModSummary) -> Maybe ModSummary -> ModSummary
forall a b. (a -> b) -> a -> b
$ [Maybe ModSummary] -> Maybe ModSummary
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ (Kind, Maybe Text) -> ModSummary
addT ((Kind, Maybe Text) -> ModSummary)
-> Maybe (Kind, Maybe Text) -> Maybe ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe (Kind, Maybe Text)] -> Maybe (Kind, Maybe Text)
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 ((Schema, Maybe Text, Maybe Fixity) -> ModSummary)
-> Maybe (Schema, Maybe Text, Maybe Fixity) -> Maybe ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Schema, Maybe Text, Maybe Fixity)
fromD
                      , (ModKind, Maybe Text) -> ModSummary
addM ((ModKind, Maybe Text) -> ModSummary)
-> Maybe (ModKind, Maybe Text) -> Maybe ModSummary
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe (ModKind, Maybe Text)] -> Maybe (ModKind, Maybe Text)
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
                                            } ModTParam -> [ModTParam] -> [ModTParam]
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
                                             } ModVParam -> [ModVParam] -> [ModVParam]
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) (Name, ModKind, Maybe Text)
-> [(Name, ModKind, Maybe Text)] -> [(Name, ModKind, Maybe Text)]
forall a. a -> [a] -> [a]
: ModSummary -> [(Name, ModKind, Maybe Text)]
msMods ModSummary
ns }


    fromTS :: Maybe (Kind, Maybe Text)
fromTS = do TySyn
def <- Name -> Map Name TySyn -> Maybe TySyn
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name TySyn
M.ifTySyns IfaceDecls
env)
                (Kind, Maybe Text) -> Maybe (Kind, Maybe Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TySyn -> Kind
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 <- Name -> Map Name Newtype -> Maybe Newtype
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name Newtype
M.ifNewtypes IfaceDecls
env)
                (Kind, Maybe Text) -> Maybe (Kind, Maybe Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Newtype -> Kind
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 <- Name -> Map Name AbstractType -> Maybe AbstractType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name AbstractType
M.ifAbstractTypes IfaceDecls
env)
                (Kind, Maybe Text) -> Maybe (Kind, Maybe Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AbstractType -> Kind
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 <- Name -> Map Name IfaceDecl -> Maybe IfaceDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name IfaceDecl
M.ifDecls IfaceDecls
env)
               (Schema, Maybe Text, Maybe Fixity)
-> Maybe (Schema, Maybe Text, Maybe Fixity)
forall a. a -> Maybe a
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 <- Name -> Map Name (IfaceNames Name) -> Maybe (IfaceNames Name)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name (IfaceNames Name)
M.ifModules IfaceDecls
env)
               (ModKind, Maybe Text) -> Maybe (ModKind, Maybe Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ModKind
M.AModule, IfaceNames Name -> Maybe Text
forall name. IfaceNames name -> Maybe Text
M.ifsDoc IfaceNames Name
def)

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

    fromS :: Maybe (ModKind, Maybe Text)
fromS = do ModParamNames
def <- Name -> Map Name ModParamNames -> Maybe ModParamNames
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name ModParamNames
M.ifSignatures IfaceDecls
env)
               (ModKind, Maybe Text) -> Maybe (ModKind, Maybe Text)
forall a. a -> Maybe a
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 (IfaceNames Name -> Maybe Text
forall name. IfaceNames name -> Maybe Text
M.ifsDoc IfaceNames Name
ns) ModSummary
summary
  where
  ns :: IfaceNames Name
ns      = IfaceG Name -> IfaceNames Name
forall name. IfaceG name -> IfaceNames name
M.ifNames IfaceG Name
info
  summary :: ModSummary
summary = (IfaceDecls -> IfaceNames Name -> ModSummary
ifaceSummary (IfaceG Name -> IfaceDecls
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 <- Map Ident ModParam -> [ModParam]
forall k a. Map k a -> [a]
Map.elems (IfaceG Name -> Map Ident ModParam
forall name. IfaceG name -> Map Ident ModParam
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 = Map Name ModTParam -> [ModTParam]
forall k a. Map k a -> [a]
Map.elems (ModParamNames -> Map Name ModTParam
T.mpnTypes ModParamNames
info)
      , msVals :: [ModVParam]
msVals  = Map Name ModVParam -> [ModVParam]
forall k a. Map k a -> [a]
Map.elems (ModParamNames -> Map Name ModVParam
T.mpnFuns ModParamNames
info)
      , msConstraints :: [Prop]
msConstraints = (Located Prop -> Prop) -> [Located Prop] -> [Prop]
forall a b. (a -> b) -> [a] -> [b]
map Located Prop -> Prop
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]
""

     Doc Void -> REPL ()
forall a. Show a => a -> REPL ()
rPrint (Doc Void -> REPL ()) -> Doc Void -> REPL ()
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
<+> Name -> Doc
forall a. PP a => a -> Doc
pp Name
name Doc -> Doc -> Doc
<+> Doc
"exports:"
                 , Int -> Doc -> Doc
indent Int
2 (Doc -> Doc) -> Doc -> Doc
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
<+> Name -> Doc
forall a. PP a => a -> Doc
pp Name
name Doc -> Doc -> Doc
<+> Doc
"requires:"
                 , Int -> Doc -> Doc
indent Int
2 (Doc -> Doc) -> Doc -> Doc
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
<+> Name -> Doc
forall a. PP a => a -> Doc
pp Name
name Doc -> Doc -> Doc
<+> Doc
"requires:"
                 , Int -> Doc -> Doc
indent Int
2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
ppPs
                 , Doc
" ", Doc
"and exports:"
                 , Int -> Doc -> Doc
indent Int
2 (Doc -> Doc) -> Doc -> Doc
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
_ -> NameFormat -> Maybe NameFormat
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 (a -> Doc
forall a. PP a => a -> Doc
pp (a -> Doc) -> Maybe a -> Maybe Doc
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 ([Char] -> Doc) -> (Fixity -> [Char]) -> Fixity -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fixity -> [Char]
ppFixity (Fixity -> Doc) -> Maybe Fixity -> Maybe Doc
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
                 [] -> Doc
forall a. Monoid a => a
mempty
                 [Doc]
_  -> [Doc] -> Doc
vcat (Doc
" " Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: [Doc]
xs)

  ppPs :: Doc
ppPs = [Doc] -> Doc
ppMany (((Ident, ImpName Name) -> Doc) -> [(Ident, ImpName Name)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Ident, ImpName Name) -> Doc
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 = Ident -> Doc
forall a. PP a => a -> Doc
pp Ident
x Doc -> Doc -> Doc
<+> Doc
": interface" Doc -> Doc -> Doc
<+> a -> Doc
forall a. PP a => a -> Doc
pp a
y
    | Bool
otherwise = Doc
"(anonymous parameter)"


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

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

  ppFPs :: Doc
ppFPs  = [Doc] -> Doc
ppMany ((ModVParam -> Doc) -> [ModVParam] -> [Doc]
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)
         (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Doc -> Doc
forall {a}. PP a => Maybe a -> Doc -> Doc
withDoc (ModVParam -> Maybe Text
T.mvpDoc ModVParam
x)
         (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [Name -> Doc
forall a. PP a => a -> Doc
pp (ModVParam -> Name
T.mvpName ModVParam
x), Doc
":" Doc -> Doc -> Doc
<+> Schema -> 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 =
  REPL () -> Maybe (REPL ()) -> REPL ()
forall a. a -> Maybe a -> a
fromMaybe (NameDisp -> Name -> REPL ()
noInfo NameDisp
nameEnv Name
name) (Maybe (REPL ()) -> REPL ()) -> Maybe (REPL ()) -> REPL ()
forall a b. (a -> b) -> a -> b
$
  [Maybe (REPL ())] -> Maybe (REPL ())
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 <- [Maybe TySyn] -> Maybe TySyn
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum [ Name -> Map Name TySyn -> Maybe TySyn
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (IfaceDecls -> Map Name TySyn
M.ifTySyns IfaceDecls
env)
                  , Name -> Map Name TySyn -> Maybe TySyn
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))
                  ]
       REPL () -> Maybe (REPL ())
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (NameDisp -> Doc -> Maybe Text -> REPL ()
doShowTyHelp NameDisp
nameEnv (TySyn -> Doc
forall a. PP a => a -> Doc
pp TySyn
ts) (TySyn -> Maybe Text
T.tsDoc TySyn
ts))

  fromNewtype :: Maybe (REPL ())
fromNewtype =
    do Newtype
nt <- Name -> Map Name Newtype -> Maybe Newtype
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 = Newtype -> Doc
forall a. PP a => a -> Doc
pp Newtype
nt Doc -> Doc -> Doc
$$ (Name -> Doc
forall a. PP a => a -> Doc
pp Name
name Doc -> Doc -> Doc
<+> [Char] -> Doc
text [Char]
":" Doc -> Doc -> Doc
<+> Schema -> Doc
forall a. PP a => a -> Doc
pp (Newtype -> Schema
T.newtypeConType Newtype
nt))
       REPL () -> Maybe (REPL ())
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (REPL () -> Maybe (REPL ())) -> REPL () -> Maybe (REPL ())
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 <- Name -> Map Name AbstractType -> Maybe AbstractType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (IfaceDecls -> Map Name AbstractType
M.ifAbstractTypes IfaceDecls
env)
       REPL () -> Maybe (REPL ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (REPL () -> Maybe (REPL ())) -> REPL () -> Maybe (REPL ())
forall a b. (a -> b) -> a -> b
$ do [Char] -> REPL ()
rPutStrLn [Char]
""
                 Doc Void -> REPL ()
forall a. Show a => a -> REPL ()
rPrint (Doc Void -> REPL ()) -> Doc Void -> REPL ()
forall a b. (a -> b) -> a -> b
$ NameDisp -> Doc -> Doc Void
runDoc NameDisp
nameEnv (Doc -> Doc Void) -> Doc -> Doc Void
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
nest Int
4
                        (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
"primitive type" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp (AbstractType -> Name
T.atName AbstractType
a)
                                   Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Kind -> 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
                 Bool -> REPL () -> REPL ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Prop] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Prop]
cs) (REPL () -> REPL ()) -> REPL () -> REPL ()
forall a b. (a -> b) -> a -> b
$
                   do let example :: Prop
example = TCon -> [Prop] -> Prop
T.TCon (AbstractType -> TCon
T.abstractTypeTC AbstractType
a)
                                           ((TParam -> Prop) -> [TParam] -> [Prop]
forall a b. (a -> b) -> [a] -> [b]
map (TVar -> Prop
T.TVar (TVar -> Prop) -> (TParam -> TVar) -> TParam -> Prop
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
<+> NameMap -> Prop -> Doc
forall a. PP (WithNames a) => NameMap -> a -> Doc
ppWithNames NameMap
ns Prop
c | Prop
c <- [Prop]
cs ]
                      [Char] -> REPL ()
rPutStrLn [Char]
""
                      Doc Void -> REPL ()
forall a. Show a => a -> REPL ()
rPrint (Doc Void -> REPL ()) -> Doc Void -> REPL ()
forall a b. (a -> b) -> a -> b
$ NameDisp -> Doc -> Doc Void
runDoc NameDisp
nameEnv (Doc -> Doc Void) -> Doc -> Doc Void
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> Doc
indent Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                                  Doc -> Doc
backticks (NameMap -> Prop -> Doc
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 -> Map Name (Maybe Ident, ModTParam)
forall a. Monoid a => a
mempty
      M.FunctorParams Map Ident ModParam
fparams ->
        [Map Name (Maybe Ident, ModTParam)]
-> Map Name (Maybe Ident, ModTParam)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
          [ (\ModTParam
x -> (Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
p,ModTParam
x)) (ModTParam -> (Maybe Ident, ModTParam))
-> Map Name ModTParam -> Map Name (Maybe Ident, ModTParam)
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) <- Map Ident ModParam -> [(Ident, ModParam)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Ident ModParam
fparams
          ]
      M.InterfaceParams ModParamNames
ps -> (\ModTParam
x -> (Maybe Ident
forall a. Maybe a
Nothing ,ModTParam
x)) (ModTParam -> (Maybe Ident, ModTParam))
-> Map Name ModTParam -> Map Name (Maybe Ident, ModTParam)
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) <- Name
-> Map Name (Maybe Ident, ModTParam)
-> Maybe (Maybe Ident, ModTParam)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name (Maybe Ident, ModTParam)
allParamNames
       REPL () -> Maybe (REPL ())
forall a. a -> Maybe a
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  -> () -> REPL ()
forall a. a -> REPL a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
               let ty :: Doc
ty = Doc
"type" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp Name
name Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Kind -> Doc
forall a. PP a => a -> Doc
pp (ModTParam -> Kind
T.mtpKind ModTParam
p)
               Doc Void -> REPL ()
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]
""
     Doc Void -> REPL ()
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 =
  REPL () -> Maybe (REPL ()) -> REPL ()
forall a. a -> Maybe a -> a
fromMaybe (NameDisp -> Name -> REPL ()
noInfo NameDisp
nameEnv Name
name)
            ([Maybe (REPL ())] -> Maybe (REPL ())
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
ifDeclSig :: IfaceDecl -> Schema
ifDeclDoc :: IfaceDecl -> Maybe Text
ifDeclFixity :: IfaceDecl -> Maybe Fixity
ifDeclName :: Name
ifDeclSig :: Schema
ifDeclIsPrim :: Bool
ifDeclPragmas :: [Pragma]
ifDeclInfix :: Bool
ifDeclFixity :: Maybe Fixity
ifDeclDoc :: Maybe Text
ifDeclName :: IfaceDecl -> Name
ifDeclIsPrim :: IfaceDecl -> Bool
ifDeclPragmas :: IfaceDecl -> [Pragma]
ifDeclInfix :: IfaceDecl -> Bool
.. } <- Name -> Map Name IfaceDecl -> Maybe IfaceDecl
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (IfaceDecls -> Map Name IfaceDecl
M.ifDecls IfaceDecls
env)
       REPL () -> Maybe (REPL ())
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (REPL () -> Maybe (REPL ())) -> REPL () -> Maybe (REPL ())
forall a b. (a -> b) -> a -> b
$
         do [Char] -> REPL ()
rPutStrLn [Char]
""

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

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

            Maybe Fixity -> REPL ()
doShowFix (Maybe Fixity -> REPL ()) -> Maybe Fixity -> REPL ()
forall a b. (a -> b) -> a -> b
$ Maybe Fixity
ifDeclFixity Maybe Fixity -> Maybe Fixity -> Maybe Fixity
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                        (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
ifDeclInfix Maybe () -> Maybe Fixity -> Maybe Fixity
forall a b. Maybe a -> Maybe b -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Fixity -> Maybe Fixity
forall a. a -> Maybe a
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
_ <- Name -> Map Name Newtype -> Maybe Newtype
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (IfaceDecls -> Map Name Newtype
M.ifNewtypes IfaceDecls
env)
       REPL () -> Maybe (REPL ())
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (REPL () -> Maybe (REPL ())) -> REPL () -> Maybe (REPL ())
forall a b. (a -> b) -> a -> b
$ () -> REPL ()
forall a. a -> REPL a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  allParamNames :: Map Name (Maybe Ident, ModVParam)
allParamNames =
    case ModContextParams
ctxparams of
      ModContextParams
M.NoParams -> Map Name (Maybe Ident, ModVParam)
forall a. Monoid a => a
mempty
      M.FunctorParams Map Ident ModParam
fparams ->
        [Map Name (Maybe Ident, ModVParam)]
-> Map Name (Maybe Ident, ModVParam)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
          [ (\ModVParam
x -> (Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
p,ModVParam
x)) (ModVParam -> (Maybe Ident, ModVParam))
-> Map Name ModVParam -> Map Name (Maybe Ident, ModVParam)
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) <- Map Ident ModParam -> [(Ident, ModParam)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Ident ModParam
fparams
          ]
      M.InterfaceParams ModParamNames
ps -> (\ModVParam
x -> (Maybe Ident
forall a. Maybe a
Nothing,ModVParam
x)) (ModVParam -> (Maybe Ident, ModVParam))
-> Map Name ModVParam -> Map Name (Maybe Ident, ModVParam)
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) <- Name
-> Map Name (Maybe Ident, ModVParam)
-> Maybe (Maybe Ident, ModVParam)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name (Maybe Ident, ModVParam)
allParamNames
       REPL () -> Maybe (REPL ())
forall a. a -> Maybe a
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 -> () -> REPL ()
forall a. a -> REPL a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
               let ty :: Doc
ty = Name -> Doc
forall a. PP a => a -> Doc
pp Name
name Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Schema -> Doc
forall a. PP a => a -> Doc
pp (ModVParam -> Schema
T.mvpType ModVParam
p)
               Doc Void -> REPL ()
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 " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Ident -> Text
P.identText Ident
i Text -> Text -> Text
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 -> () -> REPL ()
forall a. a -> REPL a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just Text
d  -> [Char] -> REPL ()
rPutStrLn (Char
'\n' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Text -> [Char]
Text.unpack Text
d)

ppFixity :: T.Fixity -> String
ppFixity :: Fixity -> [Char]
ppFixity Fixity
f = [Char]
"Precedence " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Fixity -> Int
P.fLevel Fixity
f) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", " [Char] -> [Char] -> [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' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Fixity -> [Char]
ppFixity Fixity
f)
    Maybe Fixity
Nothing -> () -> REPL ()
forall a. a -> REPL a
forall (m :: * -> *) a. Monad m => a -> m a
return ()