{-# 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
         cNames :: [Name]
cNames = Namespace -> PName -> NamingEnv -> [Name]
M.lookupListNS Namespace
M.NSConstructor 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 -> PName -> Name -> REPL ()
showConHelp IfaceDecls
env NameDisp
disp PName
qname) [Name]
cNames [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]
cNames [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 ]
                      , (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 = T.ModTParam { T.mtpName = x
                                            , T.mtpKind = k
                                            , T.mtpDoc  = d
                                            } : msTypes ns }

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

    addM :: (ModKind, Maybe Text) -> ModSummary
addM (ModKind
k,Maybe Text
d)= ModSummary
ns { msMods = (x, k, d) : msMods 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 NominalType
def <- Name -> Map Name NominalType -> Maybe NominalType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
x (IfaceDecls -> Map Name NominalType
M.ifNominalTypes IfaceDecls
env)
                (Kind, Maybe Text) -> Maybe (Kind, Maybe Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NominalType -> Kind
forall t. HasKind t => t -> Kind
T.kindOf NominalType
def, NominalType -> Maybe Text
T.ntDoc NominalType
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 = [ (T.mpName p, T.mpIface p)
                             | p <- Map.elems (M.ifParams 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 = Map.elems (T.mpnTypes info)
      , msVals  = Map.elems (T.mpnFuns info)
      , msConstraints = map P.thing (T.mpnConstraints 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 ())
fromNominal, 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))

  fromNominal :: Maybe (REPL ())
fromNominal =
    do NominalType
nt <- Name -> Map Name NominalType -> Maybe NominalType
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name (IfaceDecls -> Map Name NominalType
M.ifNominalTypes IfaceDecls
env)
       let decl :: Doc -> Doc
decl Doc
kw =
             [Doc] -> Doc
vcat
               [ Doc
kw Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp (NominalType -> Name
T.ntName NominalType
nt) Doc -> Doc -> Doc
<.> Doc
":" Doc -> Doc -> Doc
<+> Kind -> Doc
forall a. PP a => a -> Doc
pp (NominalType -> Kind
forall t. HasKind t => t -> Kind
T.kindOf NominalType
nt)
               , Doc
""
               , Doc
"Constructors:" Doc -> Doc -> Doc
<+>
                                   [Doc] -> Doc
commaSep
                                   (((Name, Schema) -> Doc) -> [(Name, Schema)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Doc
forall a. PP a => a -> Doc
pp (Name -> Doc) -> ((Name, Schema) -> Name) -> (Name, Schema) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, Schema) -> Name
forall a b. (a, b) -> a
fst) (NominalType -> [(Name, Schema)]
T.nominalTypeConTypes NominalType
nt))
               ]
       case NominalType -> NominalTypeDef
T.ntDef NominalType
nt of
         T.Struct {} -> 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
$ NameDisp -> Doc -> Maybe Text -> REPL ()
doShowTyHelp NameDisp
nameEnv (Doc -> Doc
decl Doc
"newtype") (NominalType -> Maybe Text
T.ntDoc NominalType
nt)
         T.Enum {}   -> 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
$ NameDisp -> Doc -> Maybe Text -> REPL ()
doShowTyHelp NameDisp
nameEnv (Doc -> Doc
decl Doc
"enum") (NominalType -> Maybe Text
T.ntDoc NominalType
nt)
         NominalTypeDef
T.Abstract  -> REPL () -> Maybe (REPL ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NominalType -> REPL ()
primTypeHelp NominalType
nt)

  primTypeHelp :: NominalType -> REPL ()
primTypeHelp NominalType
nt =
    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 (NominalType -> Name
T.ntName NominalType
nt)
                         Doc -> Doc -> Doc
<+> Doc
":" Doc -> Doc -> Doc
<+> Kind -> Doc
forall a. PP a => a -> Doc
pp (NominalType -> Kind
forall t. HasKind t => t -> Kind
T.kindOf NominalType
nt)

       let vs :: [TParam]
vs = NominalType -> [TParam]
T.ntParams NominalType
nt
       let cs :: [Prop]
cs = NominalType -> [Prop]
T.ntConstraints NominalType
nt
       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 = NominalType -> [Prop] -> Prop
T.TNominal NominalType
nt ((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 (NominalType -> Maybe Fixity
T.ntFixity NominalType
nt)
       Maybe Text -> REPL ()
doShowDocString (NominalType -> Maybe Text
T.ntDoc NominalType
nt)

  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

showConHelp :: M.IfaceDecls -> NameDisp -> P.PName -> T.Name -> REPL ()
showConHelp :: IfaceDecls -> NameDisp -> PName -> Name -> REPL ()
showConHelp 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) (Name -> Map Name (REPL ()) -> Maybe (REPL ())
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
name Map Name (REPL ())
allCons)
  where
  allCons :: Map Name (REPL ())
allCons = (NominalType -> Map Name (REPL ()) -> Map Name (REPL ()))
-> Map Name (REPL ()) -> Map Name NominalType -> Map Name (REPL ())
forall a b. (a -> b -> b) -> b -> Map Name a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NominalType -> Map Name (REPL ()) -> Map Name (REPL ())
addCons Map Name (REPL ())
forall a. Monoid a => a
mempty (IfaceDecls -> Map Name NominalType
M.ifNominalTypes IfaceDecls
env)
    where
    getDocs :: NominalType -> [Maybe (Maybe Text)]
getDocs NominalType
nt =
      case NominalType -> NominalTypeDef
T.ntDef NominalType
nt of
        T.Struct {} -> [ Maybe (Maybe Text)
forall a. Maybe a
Nothing ]
        T.Enum [EnumCon]
cs   -> (EnumCon -> Maybe (Maybe Text))
-> [EnumCon] -> [Maybe (Maybe Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Text -> Maybe (Maybe Text)
forall a. a -> Maybe a
Just (Maybe Text -> Maybe (Maybe Text))
-> (EnumCon -> Maybe Text) -> EnumCon -> Maybe (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumCon -> Maybe Text
T.ecDoc) [EnumCon]
cs
        NominalTypeDef
T.Abstract  -> []

    addCons :: NominalType -> Map Name (REPL ()) -> Map Name (REPL ())
addCons NominalType
nt Map Name (REPL ())
mp = (((Name, Schema), Maybe (Maybe Text))
 -> Map Name (REPL ()) -> Map Name (REPL ()))
-> Map Name (REPL ())
-> [((Name, Schema), Maybe (Maybe Text))]
-> Map Name (REPL ())
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (NominalType
-> ((Name, Schema), Maybe (Maybe Text))
-> Map Name (REPL ())
-> Map Name (REPL ())
forall {k} {a}.
(Ord k, PP a) =>
NominalType
-> ((k, a), Maybe (Maybe Text))
-> Map k (REPL ())
-> Map k (REPL ())
addCon NominalType
nt) Map Name (REPL ())
mp
                      ([(Name, Schema)]
-> [Maybe (Maybe Text)] -> [((Name, Schema), Maybe (Maybe Text))]
forall a b. [a] -> [b] -> [(a, b)]
zip (NominalType -> [(Name, Schema)]
T.nominalTypeConTypes NominalType
nt) (NominalType -> [Maybe (Maybe Text)]
getDocs NominalType
nt))
    addCon :: NominalType
-> ((k, a), Maybe (Maybe Text))
-> Map k (REPL ())
-> Map k (REPL ())
addCon NominalType
nt ((k
c,a
t),Maybe (Maybe Text)
d) = k -> REPL () -> Map k (REPL ()) -> Map k (REPL ())
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
c (REPL () -> Map k (REPL ()) -> Map k (REPL ()))
-> REPL () -> Map k (REPL ()) -> Map k (REPL ())
forall a b. (a -> b) -> a -> b
$
      do [Char] -> REPL ()
rPutStrLn [Char]
""
         Doc Void -> REPL ()
forall a. Show a => a -> REPL ()
rPrint (NameDisp -> Doc -> Doc Void
runDoc NameDisp
nameEnv (Doc -> Doc Void) -> Doc -> Doc Void
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat
            [ Doc
"Constructor of" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. PP a => a -> Doc
pp (NominalType -> Name
T.ntName NominalType
nt)
            , Int -> Doc -> Doc
indent Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [ PName -> Doc
forall a. PP a => a -> Doc
pp PName
qname, Doc
":", a -> Doc
forall a. PP a => a -> Doc
pp a
t ]
            ])
         REPL () -> (Maybe Text -> REPL ()) -> Maybe (Maybe Text) -> REPL ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> REPL ()
forall a. a -> REPL a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) Maybe Text -> REPL ()
doShowDocString Maybe (Maybe Text)
d


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 ())
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

  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 ()