module PfeBrowserMonad where import Maybe(isJust) import Monad(when) import MT(lift) import AbstractIO import FudgetIOMonad1 import PfePlumbing import PfeBrowserMenu(WindowCmd,ViewCmd,MenuCmd(..),WindowCmd(..)) import PfeBrowserGUI import PNT(PNT) import SimpleGraphs(Graph) import PropParser(parse) import PropLexer({-LexerFlags,-}pLexerPass0) import PPU(PPHsMode) import TiPropDecorate(TiDecls) -- to choose result type from the type checker import PropPosSyntax(Id,HsName,HsDecl) import FreeNamesProp() import ScopeNamesProp() import NameMapsProp() import ReAssocProp() import MapDeclMProp() -- for removing pattern bindings in Pfe3Cmds. --import TiModule() -- instance ValueId PNT import TiProp() import PFE4 import PFEdeps import PFE0 import PFE_Certs import CertCmd(CertCmd) type Opts = ({-LexerFlags,-}((Bool, PPHsMode), String, [String])) -- PFE Browser monad: --type PfeFM = PFE0MT Id HsName [HsDecl] () (WithState PfeBrowserState FIOM) --type PfeFM = WithState PfeBrowserState (PFE0MT Id HsName [HsDecl] () FIOM) type PfeFM = PFE5MT Id HsName PNT [HsDecl] (TiDecls PNT) PfeBrowserState FIOM runPfeFM pfeFM ({-lexeropts,-}opts) = runPFE5 undefined (\n a->pfeFM) (pLexerPass0 {-lexeropts-},parse) opts pfeGet = lift getFM :: PfeFM In pfePut = lift . putFM pfeQuit = lift quitFM withWaitCursor :: PfeFM a -> PfeFM a -- polymorphic recursion... withWaitCursor cmd = do pfePut (toSource setwaitcursor) tryThen cmd $ pfePut (toSource setnormalcursor) putInfoWindow (w,x) = pfePut . toInfoWindows $ (w,Right x) popupInfoWindow (w,up) = do pfePut (toMenuBar (Windows (WindowCmd w up))) when (not up && w==CertInfo) $ updStBr $ \ st ->st{certDisplay=Nothing} popupCertInfo qcert info = do putInfoWindow (CertInfo,info) popupInfoWindow (CertInfo,True) updStBr $ \ st -> st{certDisplay=Just qcert} getStBr :: PfeFM PfeBrowserState updStBr :: (PfeBrowserState->PfeBrowserState)->PfeFM () getStBr = getSt5ext updStBr = updSt5ext setStBr = updStBr . const type TInfo = PFE4Info PNT (TiDecls PNT) type ViewMode = ViewCmd data PfeBrowserState = St { -- Mode viewMode :: ViewMode, -- The selected module: modnode::ModuleNode, mrefs::[XRefInfo],hilbls::[Label], types::Maybe TInfo, certs::[CertInfo], -- Project info: revgraph::Graph ModuleName, -- Cert display/state info: certDisplay :: Maybe QCertName, -- currently displayed cert certInProgress :: [CertCmd], -- server command in progress or queued -- Project independent info: certServers :: CertServers, certIcons :: CertIcons, sadIcon :: PixmapImage } haveTypes = isJust . types modname = fst . snd . modnode noModuleNode = ("",(undefined,[])) -- for the initial state isNoModule (path,_) = null path --sccs = fst . snd . pfe2info --graph = concat . sccs icons st = (sadIcon st,certIcons st)