mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-22 19:22:50 -06:00
"Committed_by_peb"
This commit is contained in:
peb
@@ -1,18 +1,23 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Module : CheckM
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:13 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.4 $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module CheckM where
|
||||
module CheckM (Check,
|
||||
checkError, checkCond, checkWarn, checkUpdate, checkInContext,
|
||||
checkUpdates, checkReset, checkResets, checkGetContext,
|
||||
checkLookup, checkStart, checkErr, checkVal, checkIn,
|
||||
prtFail
|
||||
) where
|
||||
|
||||
import Operations
|
||||
import Grammar
|
||||
|
||||
@@ -1,22 +1,21 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Module : Comments
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:13 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.4 $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-- comment removal
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module Comments ( remComments
|
||||
) where
|
||||
|
||||
-- | comment removal : line tails prefixed by -- as well as chunks in {- ... -}
|
||||
|
||||
-- | comment removal : line tails prefixed by -- as well as chunks in @{- ... -}@
|
||||
remComments :: String -> String
|
||||
remComments s =
|
||||
case s of
|
||||
|
||||
@@ -1,18 +1,26 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Module : Ident
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:14 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.4 $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module Ident where
|
||||
module Ident (-- * Identifiers
|
||||
Ident(..), prIdent,
|
||||
identC, identV, identA, identAV, identW,
|
||||
argIdent, strVar, wildIdent, isWildIdent,
|
||||
newIdent, mkIdent, varIndex,
|
||||
-- * refreshing identifiers
|
||||
IdState, initIdStateN, initIdState,
|
||||
lookVar, refVar, refVarPlus
|
||||
) where
|
||||
|
||||
import Operations
|
||||
-- import Monad
|
||||
@@ -23,8 +31,8 @@ import Operations
|
||||
data Ident =
|
||||
IC String -- ^ raw identifier after parsing, resolved in Rename
|
||||
| IW -- ^ wildcard
|
||||
|
||||
-- below this line: internal representation never returned by the parser
|
||||
--
|
||||
-- below this constructor: internal representation never returned by the parser
|
||||
| IV (Int,String) -- ^ /INTERNAL/ variable
|
||||
| IA (String,Int) -- ^ /INTERNAL/ argument of cat at position
|
||||
| IAV (String,Int,Int) -- ^ /INTERNAL/ argument of cat with bindings at position
|
||||
|
||||
@@ -1,18 +1,39 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Module : Modules
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:15 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.19 $
|
||||
--
|
||||
-- Datastructures and functions for modules, common to GF and GFC.
|
||||
--
|
||||
-- AR 29\/4\/2003
|
||||
--
|
||||
-- The same structure will be used in both source code and canonical.
|
||||
-- The parameters tell what kind of data is involved.
|
||||
-- Invariant: modules are stored in dependency order
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module Modules where
|
||||
module Modules (MGrammar(..), ModInfo(..), Module(..), ModuleType(..), MReuseType(..),
|
||||
extendm, updateMGrammar, updateModule, replaceJudgements,
|
||||
addOpenQualif, flagsModule, allFlags, mapModules,
|
||||
MainGrammar(..), MainConcreteSpec(..), OpenSpec(..), OpenQualif(..),
|
||||
oSimple, oQualif,
|
||||
ModuleStatus(..),
|
||||
openedModule, allOpens, depPathModule, allDepsModule, partOfGrammar,
|
||||
allExtends, allExtendsPlus, allExtensions, searchPathModule, addModule,
|
||||
emptyMGrammar, emptyModInfo, emptyModule,
|
||||
IdentM(..),
|
||||
typeOfModule, abstractOfConcrete, abstractModOfConcrete,
|
||||
lookupModule, lookupModuleType, lookupModMod, lookupInfo,
|
||||
allModMod, isModAbs, isModRes, isModCnc, isModTrans,
|
||||
sameMType, isCompilableModule, isCompleteModule,
|
||||
allAbstracts, greatestAbstract, allResources, greatestResource, allConcretes
|
||||
) where
|
||||
|
||||
import Ident
|
||||
import Option
|
||||
@@ -46,25 +67,23 @@ data Module i f a = Module {
|
||||
}
|
||||
deriving Show
|
||||
|
||||
-- encoding the type of the module
|
||||
-- | encoding the type of the module
|
||||
data ModuleType i =
|
||||
MTAbstract
|
||||
| MTTransfer (OpenSpec i) (OpenSpec i)
|
||||
| MTResource
|
||||
| MTConcrete i
|
||||
|
||||
-- up to this, also used in GFC. Below, source only.
|
||||
|
||||
-- ^ up to this, also used in GFC. Below, source only.
|
||||
| MTInterface
|
||||
| MTInstance i
|
||||
| MTReuse (MReuseType i)
|
||||
| MTUnion (ModuleType i) [(i,[i])] --- not meant to be recursive
|
||||
| MTUnion (ModuleType i) [(i,[i])] -- ^ not meant to be recursive
|
||||
deriving (Eq,Show)
|
||||
|
||||
data MReuseType i = MRInterface i | MRInstance i i | MRResource i
|
||||
deriving (Show,Eq)
|
||||
|
||||
-- previously: single inheritance
|
||||
-- | previously: single inheritance
|
||||
extendm :: Module i f a -> Maybe i
|
||||
extendm m = case extends m of
|
||||
[i] -> Just i
|
||||
@@ -72,7 +91,7 @@ extendm m = case extends m of
|
||||
|
||||
-- destructive update
|
||||
|
||||
--- dep order preserved since old cannot depend on new
|
||||
-- | dep order preserved since old cannot depend on new
|
||||
updateMGrammar :: Ord i => MGrammar i f a -> MGrammar i f a -> MGrammar i f a
|
||||
updateMGrammar old new = MGrammar $
|
||||
[(i,m) | (i,m) <- os, notElem i (map fst ns)] ++ ns
|
||||
@@ -114,8 +133,8 @@ data MainGrammar i = MainGrammar {
|
||||
data MainConcreteSpec i = MainConcreteSpec {
|
||||
concretePrintname :: i ,
|
||||
concreteName :: i ,
|
||||
transferIn :: Maybe (OpenSpec i) , -- if there is an in-transfer
|
||||
transferOut :: Maybe (OpenSpec i) -- if there is an out-transfer
|
||||
transferIn :: Maybe (OpenSpec i) , -- ^ if there is an in-transfer
|
||||
transferOut :: Maybe (OpenSpec i) -- ^ if there is an out-transfer
|
||||
}
|
||||
deriving Show
|
||||
|
||||
@@ -147,7 +166,7 @@ allOpens m = case mtype m of
|
||||
MTTransfer a b -> a : b : opens m
|
||||
_ -> opens m
|
||||
|
||||
-- initial dependency list
|
||||
-- | initial dependency list
|
||||
depPathModule :: Ord i => Module i f a -> [OpenSpec i]
|
||||
depPathModule m = fors m ++ exts m ++ opens m where
|
||||
fors m = case mtype m of
|
||||
@@ -157,7 +176,7 @@ depPathModule m = fors m ++ exts m ++ opens m where
|
||||
_ -> []
|
||||
exts m = map oSimple $ extends m
|
||||
|
||||
-- all dependencies
|
||||
-- | all dependencies
|
||||
allDepsModule :: Ord i => MGrammar i f a -> Module i f a -> [OpenSpec i]
|
||||
allDepsModule gr m = iterFix add os0 where
|
||||
os0 = depPathModule m
|
||||
@@ -165,7 +184,7 @@ allDepsModule gr m = iterFix add os0 where
|
||||
m <- depPathModule n]
|
||||
mods = modules gr
|
||||
|
||||
-- select just those modules that a given one depends on, including itself
|
||||
-- | select just those modules that a given one depends on, including itself
|
||||
partOfGrammar :: Ord i => MGrammar i f a -> (i,ModInfo i f a) -> MGrammar i f a
|
||||
partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
|
||||
where
|
||||
@@ -175,7 +194,7 @@ partOfGrammar gr (i,m) = MGrammar [mo | mo@(j,_) <- mods, elem j modsFor]
|
||||
_ -> [i] ---- ModWith?
|
||||
|
||||
|
||||
-- all modules that a module extends, directly or indirectly
|
||||
-- | all modules that a module extends, directly or indirectly
|
||||
allExtends :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
|
||||
allExtends gr i = case lookupModule gr i of
|
||||
Ok (ModMod m) -> case extends m of
|
||||
@@ -183,7 +202,7 @@ allExtends gr i = case lookupModule gr i of
|
||||
is -> i : concatMap (allExtends gr) is
|
||||
_ -> []
|
||||
|
||||
-- this plus that an instance extends its interface
|
||||
-- | this plus that an instance extends its interface
|
||||
allExtendsPlus :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
|
||||
allExtendsPlus gr i = case lookupModule gr i of
|
||||
Ok (ModMod m) -> i : concatMap (allExtendsPlus gr) (exts m)
|
||||
@@ -191,7 +210,7 @@ allExtendsPlus gr i = case lookupModule gr i of
|
||||
where
|
||||
exts m = extends m ++ [j | MTInstance j <- [mtype m]]
|
||||
|
||||
-- conversely: all modules that extend a given module, incl. instances of interface
|
||||
-- | conversely: all modules that extend a given module, incl. instances of interface
|
||||
allExtensions :: (Show i,Ord i) => MGrammar i f a -> i -> [i]
|
||||
allExtensions gr i = case lookupModule gr i of
|
||||
Ok (ModMod m) -> let es = exts i in es ++ concatMap (allExtensions gr) es
|
||||
@@ -201,11 +220,11 @@ allExtensions gr i = case lookupModule gr i of
|
||||
|| elem (MTInstance i) [mtype m]]
|
||||
mods = [(j,m) | (j,ModMod m) <- modules gr]
|
||||
|
||||
-- initial search path: the nonqualified dependencies
|
||||
-- | initial search path: the nonqualified dependencies
|
||||
searchPathModule :: Ord i => Module i f a -> [i]
|
||||
searchPathModule m = [i | OSimple _ i <- depPathModule m]
|
||||
|
||||
-- a new module can safely be added to the end, since nothing old can depend on it
|
||||
-- | a new module can safely be added to the end, since nothing old can depend on it
|
||||
addModule :: Ord i =>
|
||||
MGrammar i f a -> i -> ModInfo i f a -> MGrammar i f a
|
||||
addModule gr name mi = MGrammar $ (modules gr ++ [(name,mi)])
|
||||
@@ -219,8 +238,7 @@ emptyModInfo = ModMod emptyModule
|
||||
emptyModule :: Module i f a
|
||||
emptyModule = Module MTResource MSComplete [] [] [] NT
|
||||
|
||||
-- we store the module type with the identifier
|
||||
|
||||
-- | we store the module type with the identifier
|
||||
data IdentM i = IdentM {
|
||||
identM :: i ,
|
||||
typeM :: ModuleType i
|
||||
@@ -310,38 +328,38 @@ sameMType m n = case (m,n) of
|
||||
(MTInterface,MTResource) -> True
|
||||
_ -> m == n
|
||||
|
||||
-- don't generate code for interfaces and for incomplete modules
|
||||
-- | don't generate code for interfaces and for incomplete modules
|
||||
isCompilableModule m = case m of
|
||||
ModMod m -> case mtype m of
|
||||
MTInterface -> False
|
||||
_ -> mstatus m == MSComplete
|
||||
_ -> False ---
|
||||
|
||||
-- interface and "incomplete M" are not complete
|
||||
-- | interface and "incomplete M" are not complete
|
||||
isCompleteModule :: (Eq i) => Module i f a -> Bool
|
||||
isCompleteModule m = mstatus m == MSComplete && mtype m /= MTInterface
|
||||
|
||||
|
||||
-- all abstract modules
|
||||
-- | all abstract modules
|
||||
allAbstracts :: Eq i => MGrammar i f a -> [i]
|
||||
allAbstracts gr = [i | (i,ModMod m) <- modules gr, mtype m == MTAbstract]
|
||||
|
||||
-- the last abstract in dependency order (head of list)
|
||||
-- | the last abstract in dependency order (head of list)
|
||||
greatestAbstract :: Eq i => MGrammar i f a -> Maybe i
|
||||
greatestAbstract gr = case allAbstracts gr of
|
||||
[] -> Nothing
|
||||
a:_ -> return a
|
||||
|
||||
-- all resource modules
|
||||
-- | all resource modules
|
||||
allResources :: MGrammar i f a -> [i]
|
||||
allResources gr = [i | (i,ModMod m) <- modules gr, isModRes m]
|
||||
|
||||
-- the greatest resource in dependency order
|
||||
-- | the greatest resource in dependency order
|
||||
greatestResource :: MGrammar i f a -> Maybe i
|
||||
greatestResource gr = case allResources gr of
|
||||
[] -> Nothing
|
||||
a -> return $ head a
|
||||
|
||||
-- all concretes for a given abstract
|
||||
-- | all concretes for a given abstract
|
||||
allConcretes :: Eq i => MGrammar i f a -> i -> [i]
|
||||
allConcretes gr a = [i | (i, ModMod m) <- modules gr, mtype m == MTConcrete a]
|
||||
|
||||
@@ -1,18 +1,72 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Module : Option
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:15 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.19 $
|
||||
--
|
||||
-- Options and flags used in GF shell commands and files.
|
||||
--
|
||||
-- The types 'Option' and 'Options' should be kept abstract, but:
|
||||
--
|
||||
-- - The constructor 'Opt' is used in "ShellCommands" and "GrammarToSource"
|
||||
--
|
||||
-- - The constructor 'Opts' us udes in "API", "Shell" and "ShellCommands"
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module Option where
|
||||
module Option (-- * all kinds of options, should be kept abstract
|
||||
Option(..), Options(..), OptFun, OptFunId,
|
||||
noOptions, iOpt, aOpt, iOpts, oArg, oElem, eqOpt,
|
||||
getOptVal, getOptInt, optIntOrAll, optIntOrN, optIntOrOne,
|
||||
changeOptVal, addOption, addOptions, concatOptions,
|
||||
removeOption, removeOptions, options, unionOptions,
|
||||
|
||||
-- * parsing options, with prefix pre (e.g. \"-\")
|
||||
getOptions, pOption, isOption,
|
||||
|
||||
-- * printing options, without prefix
|
||||
prOpt, prOpts,
|
||||
|
||||
-- * a suggestion for option names
|
||||
-- ** parsing
|
||||
strictParse, forgiveParse, ignoreParse, literalParse,
|
||||
rawParse, firstParse, dontParse,
|
||||
-- ** grammar formats
|
||||
showAbstr, showXML, showOld, showLatex, showFullForm,
|
||||
showEBNF, showCF, showWords, showOpts,
|
||||
isCompiled, isHaskell, noCompOpers, retainOpers, defaultGrOpts,
|
||||
newParser, noCF, checkCirc, noCheckCirc, lexerByNeed,
|
||||
-- ** linearization
|
||||
allLin, firstLin, distinctLin, dontLin, showRecord, showStruct,
|
||||
xmlLin, latexLin, tableLin, defaultLinOpts, useUTF8, showLang, withMetas,
|
||||
-- ** other
|
||||
beVerbose, showInfo, beSilent, emitCode, getHelp, doMake, doBatch,
|
||||
notEmitCode, makeMulti, beShort, wholeGrammar, makeFudget, byLines, byWords,
|
||||
analMorpho, doTrace, noCPU, doCompute, optimizeCanon, optimizeValues,
|
||||
stripQualif, nostripQualif, showAll, fromSource,
|
||||
-- ** mainly for stand-alone
|
||||
useUnicode, optCompute, optCheck, optParaphrase, forJava,
|
||||
-- ** for edit session
|
||||
allLangs, absView,
|
||||
-- ** options that take arguments
|
||||
useTokenizer, useUntokenizer, useParser, withFun, firstCat, gStartCat,
|
||||
useLanguage, useResource, speechLanguage, useFont,
|
||||
grammarFormat, grammarPrinter, filterString, termCommand, transferFun,
|
||||
forForms, menuDisplay, sizeDisplay, typeDisplay,
|
||||
noDepTypes, extractGr, pathList, uniCoding,
|
||||
useName, useAbsName, useCncName, useResName, useFile, useOptimizer,
|
||||
markLin, markOptXML, markOptJava, markOptStruct, markOptFocus,
|
||||
-- ** refinement order
|
||||
nextRefine, firstRefine, lastRefine,
|
||||
-- ** Boolean flags
|
||||
flagYes, flagNo, caseYesNo,
|
||||
-- ** integer flags
|
||||
flagDepth, flagAlts, flagLength, flagNumber, flagRawtrees
|
||||
) where
|
||||
|
||||
import List (partition)
|
||||
import Char (isDigit)
|
||||
@@ -25,11 +79,20 @@ newtype Options = Opts [Option] deriving (Eq,Show,Read)
|
||||
noOptions :: Options
|
||||
noOptions = Opts []
|
||||
|
||||
iOpt o = Opt (o,[]) -- simple option -o
|
||||
aOpt o a = Opt (o,[a]) -- option with argument -o=a
|
||||
iOpt :: String -> Option
|
||||
iOpt o = Opt (o,[])
|
||||
-- ^ simple option -o
|
||||
|
||||
aOpt :: String -> String -> Option
|
||||
aOpt o a = Opt (o,[a])
|
||||
-- ^ option with argument -o=a
|
||||
|
||||
iOpts :: [Option] -> Options
|
||||
iOpts = Opts
|
||||
|
||||
oArg s = s -- value of option argument
|
||||
oArg :: String -> String
|
||||
oArg s = s
|
||||
-- ^ value of option argument
|
||||
|
||||
oElem :: Option -> Options -> Bool
|
||||
oElem o (Opts os) = elem o os
|
||||
|
||||
@@ -1,26 +1,28 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Module : ReadFiles
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:15 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.19 $
|
||||
--
|
||||
-- Decide what files to read as function of dependencies and time stamps.
|
||||
--
|
||||
-- make analysis for GF grammar modules. AR 11\/6\/2003--24\/2\/2004
|
||||
--
|
||||
-- to find all files that have to be read, put them in dependency order, and
|
||||
-- decide which files need recompilation. Name @file.gf@ is returned for them,
|
||||
-- and @file.gfc@ or @file.gfr@ otherwise.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module ReadFiles
|
||||
--- where
|
||||
|
||||
--
|
||||
(
|
||||
--
|
||||
getAllFiles,fixNewlines,ModName,getOptionsFromFile,
|
||||
--
|
||||
gfcFile,gfFile,gfrFile,isGFC,resModName,isOldFile) where
|
||||
module ReadFiles (-- * Heading 1
|
||||
getAllFiles,fixNewlines,ModName,getOptionsFromFile,
|
||||
-- * Heading 2
|
||||
gfcFile,gfFile,gfrFile,isGFC,resModName,isOldFile
|
||||
) where
|
||||
|
||||
import Arch (selectLater, modifiedFiles, ModTime, getModTime,laterModTime)
|
||||
|
||||
@@ -34,12 +36,6 @@ import Monad
|
||||
import List
|
||||
import Directory
|
||||
|
||||
-- make analysis for GF grammar modules. AR 11/6/2003--24/2/2004
|
||||
|
||||
-- to find all files that have to be read, put them in dependency order, and
|
||||
-- decide which files need recompilation. Name file.gf is returned for them,
|
||||
-- and file.gfc or file.gfr otherwise.
|
||||
|
||||
type ModName = String
|
||||
type ModEnv = [(ModName,ModTime)]
|
||||
|
||||
@@ -292,15 +288,14 @@ lexs s = x:xs where
|
||||
(x,y) = head $ lex s
|
||||
xs = if null y then [] else lexs y
|
||||
|
||||
-- options can be passed to the compiler by comments in --#, in the main file
|
||||
|
||||
-- | options can be passed to the compiler by comments in @--#@, in the main file
|
||||
getOptionsFromFile :: FilePath -> IO Options
|
||||
getOptionsFromFile file = do
|
||||
s <- readFileIf file
|
||||
let ls = filter (isPrefixOf "--#") $ lines s
|
||||
return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls
|
||||
|
||||
-- check if old GF file
|
||||
-- | check if old GF file
|
||||
isOldFile :: FilePath -> IO Bool
|
||||
isOldFile f = do
|
||||
s <- readFileIf f
|
||||
@@ -312,7 +307,7 @@ isOldFile f = do
|
||||
|
||||
|
||||
|
||||
-- old GF tolerated newlines in quotes. No more supported!
|
||||
-- | old GF tolerated newlines in quotes. No more supported!
|
||||
fixNewlines :: String -> String
|
||||
fixNewlines s = case s of
|
||||
'"':cs -> '"':mk cs
|
||||
|
||||
@@ -1,18 +1,60 @@
|
||||
----------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : (Module)
|
||||
-- Maintainer : (Maintainer)
|
||||
-- Module : UseIO
|
||||
-- Maintainer : AR
|
||||
-- Stability : (stable)
|
||||
-- Portability : (portable)
|
||||
--
|
||||
-- > CVS $Date $
|
||||
-- > CVS $Author $
|
||||
-- > CVS $Revision $
|
||||
-- > CVS $Date: 2005/02/18 19:21:16 $
|
||||
-- > CVS $Author: peb $
|
||||
-- > CVS $Revision: 1.8 $
|
||||
--
|
||||
-- (Description of the module)
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module UseIO where
|
||||
module UseIO (prOptCPU,
|
||||
putCPU,
|
||||
putPoint,
|
||||
putPoint',
|
||||
readFileIf,
|
||||
FileName,
|
||||
InitPath,
|
||||
FullPath,
|
||||
getFilePath,
|
||||
readFileIfPath,
|
||||
doesFileExistPath,
|
||||
extendPathEnv,
|
||||
pFilePaths,
|
||||
prefixPathName,
|
||||
justInitPath,
|
||||
nameAndSuffix,
|
||||
unsuffixFile, fileBody,
|
||||
fileSuffix,
|
||||
justFileName,
|
||||
suffixFile,
|
||||
justModuleName,
|
||||
getLineWell,
|
||||
putStrFlush,
|
||||
putStrLnFlush,
|
||||
-- * a generic quiz session
|
||||
QuestionsAndAnswers,
|
||||
teachDialogue,
|
||||
-- * IO monad with error; adapted from state monad
|
||||
IOE(..),
|
||||
appIOE,
|
||||
ioe,
|
||||
ioeIO,
|
||||
ioeErr,
|
||||
ioeBad,
|
||||
useIOE,
|
||||
foldIOE,
|
||||
putStrLnE,
|
||||
putStrE,
|
||||
putPointE,
|
||||
putPointEVerb,
|
||||
readFileIOE,
|
||||
readFileLibraryIOE
|
||||
) where
|
||||
|
||||
import Operations
|
||||
import Arch (prCPU)
|
||||
@@ -35,7 +77,7 @@ putIfVerbW opts msg =
|
||||
then putStr (' ' : msg)
|
||||
else return ()
|
||||
|
||||
-- obsolete with IOE monad
|
||||
-- | obsolete with IOE monad
|
||||
errIO :: a -> Err a -> IO a
|
||||
errIO = errOptIO noOptions
|
||||
|
||||
@@ -95,7 +137,7 @@ doesFileExistPath paths file = do
|
||||
mpfile <- ioeIO $ getFilePath paths file
|
||||
return $ maybe False (const True) mpfile
|
||||
|
||||
-- path in environment variable has lower priority
|
||||
-- | path in environment variable has lower priority
|
||||
extendPathEnv :: String -> [FilePath] -> IO [FilePath]
|
||||
extendPathEnv var ps = do
|
||||
s <- catch (getEnv var) (const (return ""))
|
||||
@@ -243,7 +285,7 @@ putPointE opts msg act = do
|
||||
return a
|
||||
-}
|
||||
|
||||
-- forces verbosity
|
||||
-- | forces verbosity
|
||||
putPointEVerb :: Options -> String -> IOE a -> IOE a
|
||||
putPointEVerb opts = putPointE (addOption beVerbose opts)
|
||||
|
||||
@@ -252,9 +294,10 @@ readFileIOE :: FilePath -> IOE (String)
|
||||
readFileIOE f = ioe $ catch (readFile f >>= return . return)
|
||||
(\_ -> return (Bad (reportOn f))) where
|
||||
reportOn f = "File " ++ f ++ " not found."
|
||||
|
||||
-- like readFileIOE but look also in the GF library if file not found
|
||||
-- intended semantics: if file is not found, try $GF_LIB_PATH/file
|
||||
|
||||
-- | like readFileIOE but look also in the GF library if file not found
|
||||
--
|
||||
-- intended semantics: if file is not found, try @\$GF_LIB_PATH\/file@
|
||||
-- (even if file is an absolute path, but this should always fail)
|
||||
-- it returns not only contents of the file, but also the path used
|
||||
readFileLibraryIOE :: String -> FilePath -> IOE (FilePath, String)
|
||||
@@ -281,7 +324,7 @@ readFileLibraryIOE ini f =
|
||||
_ -> ini ++ file -- relative path name
|
||||
|
||||
|
||||
-- example
|
||||
-- | example
|
||||
koeIOE :: IO ()
|
||||
koeIOE = useIOE () $ do
|
||||
s <- ioeIO $ getLine
|
||||
|
||||
Reference in New Issue
Block a user