remove all files that aren't used in GF-3.0

4 files changed, 0 insertions, 862 deletions

diff --git a/src-3.0/GF/Infra/Comments.hs b/src-3.0/GF/Infra/Comments.hs
deleted file mode 100644
index 0126db468..000000000
--- a/src-3.0/GF/Infra/Comments.hs
+++ /dev/null
@@ -1,43 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : Comments
--- Maintainer  : (Maintainer)
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/04/21 16:22:34 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.5 $
---
--- comment removal
------------------------------------------------------------------------------
-
-module GF.Infra.Comments ( remComments
-		) where
-
--- | comment removal : line tails prefixed by -- as well as chunks in @{- ... -}@
-remComments :: String -> String
-remComments s = 
-  case s of
-    '"':s2 -> '"':pass remComments s2 -- comment marks in quotes not removed!
-    '{':'-':cs -> readNested cs
-    '-':'-':cs -> readTail cs
-    c:cs -> c : remComments cs
-    [] -> []
-   where
-     readNested t = 
-       case t of
-         '"':s2 -> '"':pass readNested s2
-         '-':'}':cs -> remComments cs
-         _:cs -> readNested cs
-         [] -> []
-     readTail t = 
-       case t of
-         '\n':cs -> '\n':remComments cs
-         _:cs -> readTail cs
-         [] -> []
-     pass f t = 
-       case t of
-         '"':s2 -> '"': f s2
-         c:s2 -> c:pass f s2
-         _ -> t
diff --git a/src-3.0/GF/Infra/Print.hs b/src-3.0/GF/Infra/Print.hs
deleted file mode 100644
index 17f2c2188..000000000
--- a/src-3.0/GF/Infra/Print.hs
+++ /dev/null
@@ -1,127 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Maintainer  : PL
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/06/17 14:15:18 $ 
--- > CVS $Author: bringert $
--- > CVS $Revision: 1.4 $
---
--- Pretty-printing
------------------------------------------------------------------------------
-
-module GF.Infra.Print
-    (module GF.Infra.PrintClass
-    ) where
-
--- haskell modules:
-import Data.Char (toUpper)
--- gf modules:
-
-import GF.Infra.PrintClass
-import GF.Data.Operations (Err(..))
-import GF.Infra.Ident (Ident(..))
-import GF.Canon.AbsGFC
-import GF.CF.CF
-import GF.CF.CFIdent
-import qualified GF.Canon.PrintGFC as P
-
-------------------------------------------------------------
-
-----------------------------------------------------------------------
-
-instance Print Ident where
-    prt = P.printTree 
-
-instance Print Term where
-    prt (Arg arg)         = prt arg
-    prt (con `Par` [])    = prt con
-    prt (con `Par` terms) = prt con ++ "(" ++ prtSep ", " terms ++ ")"
-    prt (LI ident)        = "$" ++ prt ident
-    prt (R record)        = "{" ++ prtSep "; " record ++ "}"
-    prt (term `P` lbl)    = prt term ++ "." ++ prt lbl
-    prt (T _ table)       = "table{" ++ prtSep "; " table ++ "}"
-    prt (V _ terms)       = "values{" ++ prtSep "; " terms ++ "}"
-    prt (term `S` sel)    = "(" ++ prt term ++ " ! " ++ prt sel ++ ")"
-    prt (FV terms)        = "variants{" ++ prtSep " | " terms ++ "}"
-    prt (term `C` term')  = prt term ++ "  " ++ prt term'
-    prt (EInt n)          = prt n
-    prt (K tokn)          = show (prt tokn)
-    prt (E)               = show ""
-
-instance Print Patt where
-    prt (con `PC` [])     = prt con
-    prt (con `PC` pats)   = prt con ++ "(" ++ prtSep "," pats ++ ")"
-    prt (PV ident)        = "$" ++ prt ident
-    prt (PW)              = "_"
-    prt (PR record)       = "{" ++ prtSep ";" record ++ "}"
-
-instance Print Label where
-    prt (L ident)          = prt ident
-    prt (LV nr)            = "$" ++ show nr
-
-instance Print Tokn where
-    prt (KS str)          = str
-    prt tokn@(KP _ _)     = show tokn
-
-instance Print ArgVar where
-    prt (A cat argNr)     = prt cat ++ "#" ++ show argNr
-
-instance Print CIdent where
-    prt (CIQ _ ident)     = prt ident
-
-instance Print Case where
-    prt (pats `Cas` term) = prtSep "|" pats ++ "=>" ++ prt term
-
-instance Print Assign where
-    prt (lbl `Ass` term)  = prt lbl ++ "=" ++ prt term
-
-instance Print PattAssign where
-    prt (lbl `PAss` pat)  = prt lbl ++ "=" ++ prt pat
-
-instance Print Atom where
-    prt (AC c) = prt c
-    prt (AD c) = "<" ++ prt c ++ ">"
-    prt (AV i) = "$" ++ prt i
-    prt (AM n) = "?" ++ show n
-    prt atom   = show atom
-
-instance Print CType where
-    prt (RecType rtype) = "{" ++ prtSep "; " rtype ++ "}"
-    prt (Table ptype vtype) = "(" ++ prt ptype ++ " => " ++ prt vtype ++ ")"
-    prt (Cn cn) = prt cn
-    prt (TStr) = "Str"
-
-instance Print Labelling where
-    prt (lbl `Lbg` ctype) = prt lbl ++ ":" ++ prt ctype
-
-instance Print CFItem where
-    prt (CFTerm regexp) = prt regexp
-    prt (CFNonterm cat) = prt cat
-
-instance Print RegExp where
-    prt (RegAlts words) = "("++prtSep "|" words ++ ")"
-    prt (RegSpec tok) = prt tok
-
-instance Print CFTok where
-    prt (TS str) = str
-    prt (TC (c:str)) = '(' : toUpper c : ')' : str
-    prt (TL str) = show str
-    prt (TI n) = "#" ++ show n
-    prt (TV x) = "$" ++ prt x
-    prt (TM n s) = "?" ++ show n ++ s
-
-instance Print CFCat where
-    prt (CFCat (cid,lbl)) = prt cid ++ "-" ++ prt lbl
-
-instance Print CFFun where 
-    prt (CFFun fun) = prt (fst fun)
-
-instance Print Exp where
-    prt = P.printTree
-
-instance Print a => Print (Err a) where
-    prt (Ok a) = prt a
-    prt (Bad str) = str
-
diff --git a/src-3.0/GF/Infra/ReadFiles.hs b/src-3.0/GF/Infra/ReadFiles.hs
deleted file mode 100644
index ce33ec23f..000000000
--- a/src-3.0/GF/Infra/ReadFiles.hs
+++ /dev/null
@@ -1,362 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module      : ReadFiles
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/11 23:24:34 $ 
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.26 $
---
--- 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 GF.Infra.ReadFiles (-- * Heading 1
-		  getAllFiles,fixNewlines,ModName,getOptionsFromFile,
-		  -- * Heading 2
-		  gfcFile,gfFile,gfrFile,isGFC,resModName,isOldFile
-		 ) where
-
-import GF.System.Arch (selectLater, modifiedFiles, ModTime, getModTime,laterModTime)
-
-import GF.Infra.Option
-import GF.Data.Operations
-import GF.Infra.UseIO
-
-import System
-import Data.Char
-import Control.Monad
-import Data.List
-import System.Directory
-import System.FilePath
-
-type ModName = String
-type ModEnv  = [(ModName,ModTime)]
-
-getAllFiles :: Options -> [InitPath] -> ModEnv -> FileName -> IOE [FullPath]
-getAllFiles opts ps env file = do
-
-  -- read module headers from all files recursively
-  ds0  <- getImports ps file
-  let ds = [((snd m,map fst ms),p) | ((m,ms),p) <- ds0]
-  if oElem beVerbose opts 
-    then ioeIO $ putStrLn $ "all modules:" +++ show (map (fst . fst) ds)
-    else return ()
-    -- get a topological sorting of files: returns file names --- deletes paths
-  ds1 <- ioeErr $ either 
-           return 
-           (\ms -> Bad $ "circular modules" +++ 
-                     unwords (map show (head ms))) $ topoTest $ map fst ds
-
-  -- associate each file name with its path --- more optimal: save paths in ds1
-  let paths = [(f,p) | ((f,_),p) <- ds]
-  let pds1 = [(p,f) | f <- ds1, Just p <- [lookup f paths]]
-  if oElem fromSource opts 
-    then return [gfFile (p </> f) | (p,f) <- pds1]
-    else do
-
-
-    ds2 <- ioeIO $ mapM (selectFormat opts env) pds1
-
-    let ds4 = needCompile opts (map fst ds0) ds2
-    return ds4
-
--- to decide whether to read gf or gfc, or if in env; returns full file path
-
-data CompStatus =
-   CSComp -- compile: read gf
- | CSRead -- read gfc
- | CSEnv  -- gfc is in env
- | CSEnvR -- also gfr is in env
- | CSDont -- don't read at all
- | CSRes  -- read gfr
-  deriving (Eq,Show)
-
--- for gfc, we also return ModTime to cope with earlier compilation of libs
-
-selectFormat :: Options -> ModEnv -> (InitPath,ModName) -> 
-                IO (ModName,(InitPath,(CompStatus,Maybe ModTime)))
-
-selectFormat opts env (p,f) = do
-  let pf = p </> f
-  let mtenv = lookup f env   -- Nothing if f is not in env
-  let rtenv = lookup (resModName f) env
-  let fromComp = oElem isCompiled opts -- i -gfc
-  mtgfc <- getModTime $ gfcFile pf
-  mtgf  <- getModTime $ gfFile pf
-  let stat = case (rtenv,mtenv,mtgfc,mtgf) of
---        (_,Just tenv,_,_)        | fromComp -> (CSEnv, Just tenv)
-        (_,_,Just tgfc,_)        | fromComp -> (CSRead,Just tgfc)
---        (Just tenv,_,_,Just tgf) | laterModTime tenv tgf -> (CSEnvR,Just tenv)
---        (_,Just tenv,_,Just tgf) | laterModTime tenv tgf -> (CSEnv, Just tenv)
-        (_,_,Just tgfc,Just tgf) | laterModTime tgfc tgf -> 
-          case mtenv of 
---            Just tenv | laterModTime tenv tgfc -> (CSEnv,Just tenv)
-            _ -> (CSRead,Just tgfc)
-
-
---        (_,Just tenv,_,Nothing) -> (CSEnv,Just tenv) -- source does not exist
-        (_,_,_,        Nothing) -> (CSRead,Nothing)  -- source does not exist
-        _ -> (CSComp,Nothing)
-  return $ (f, (p,stat))
-
-needCompile :: Options -> 
-               [ModuleHeader] -> 
-               [(ModName,(InitPath,(CompStatus,Maybe ModTime)))] -> [FullPath]
-needCompile opts headers sfiles0 = paths $ res $ mark $ iter changed where
-
-  deps = [(snd m,map fst ms) | (m,ms) <- headers]
-  typ m = maybe MTyOther id $ lookup m [(m,t) | ((t,m),_) <- headers]
-  uses m = [(n,u) | ((_,n),ms) <- headers, (k,u) <- ms, k==m]
-  stat0 m = maybe CSComp (fst . snd) $ lookup m sfiles0
-
-  allDeps = [(m,iterFix add ms) | (m,ms) <- deps] where
-    add os = [m | o <- os, Just n <- [lookup o deps],m <- n]
-
-  -- only treat reused, interface, or instantiation if needed
-  sfiles = sfiles0 ---- map relevant sfiles0
-  relevant fp@(f,(p,(st,_))) = 
-    let us = uses f
-        isUsed = not (null us)
-    in
-    if not (isUsed && all noComp us) then
-      fp else 
-    if (elem (typ f) [] ---- MTyIncomplete, MTyIncResource]
-        || 
-        (isUsed && all isAux us)) then
-      (f,(p,(CSDont,Nothing))) else
-      fp
-
-  isAux = flip elem [MUReuse,MUInstance,MUComplete] . snd
-  noComp = flip elem [CSRead,CSEnv,CSEnvR] . stat0 . fst
-
-  -- mark as to be compiled those whose gfc is earlier than a deeper gfc
-  sfiles1 = map compTimes sfiles
-  compTimes fp@(f,(p,(_, Just t))) =
-    if any (> t) [t' | Just fs <- [lookup f deps], 
-                       f0 <- fs,
-                       Just (_,(_,Just t')) <- [lookup f0 sfiles]]
-    then (f,(p,(CSComp, Nothing)))
-    else fp
-  compTimes fp = fp
-
-  -- start with the changed files themselves; returns [ModName]
-  changed = [f | (f,(_,(CSComp,_))) <- sfiles1] 
-
-  -- add other files that depend on some changed file; returns [ModName]
-  iter np = let new = [f | (f,fs) <- deps, 
-                           not (elem f np), any (flip elem np) fs]
-            in  if null new then np else (iter (new ++ np))
-
-  -- for each module in the full list, compile if depends on what needs compile
-  -- returns [FullPath]
-  mark cs = [(f,(path,st)) | 
-                (f,(path,(st0,_))) <- sfiles1, 
-                let st = if (elem f cs) then CSComp else st0]
-
-
-  -- if a compilable file depends on a resource, read gfr instead of gfc/env
-  -- but don't read gfr if already in env (by CSEnvR)
-  -- Also read res if the option "retain" is present
-  -- Also, if a "with" file has to be compiled, read its mother file from source
-
-  res cs = map mkRes cs where
-    mkRes x@(f,(path,st)) | elem st [CSRead,CSEnv] = case typ f of
-      t | (not (null [m | (m,(_,CSComp)) <- cs,
-                                   Just ms <- [lookup m allDeps], elem f ms])
-                    || oElem retainOpers opts)
-        -> if elem t [MTyResource,MTyIncResource] 
-           then (f,(path,CSRes)) else
-              if t == MTyIncomplete
-              then (f,(path,CSComp)) else
-              x
-      _ -> x
-    mkRes x = x
-
-
-
-  -- construct list of paths to read
-  paths cs = [mkName f p st | (f,(p,st)) <- cs, elem st [CSComp, CSRead,CSRes]]
-
-  mkName f p st = mk (p </> f) where
-    mk = case st of
-      CSComp -> gfFile
-      CSRead -> gfcFile
-      CSRes  -> gfrFile
-
-isGFC :: FilePath -> Bool
-isGFC = (== ".gfc") . takeExtensions
-
-gfcFile :: FilePath -> FilePath
-gfcFile f = addExtension f "gfc"
-
-gfrFile :: FilePath -> FilePath
-gfrFile f = addExtension f "gfr"
-
-gfFile :: FilePath -> FilePath
-gfFile f = addExtension f "gf"
-
-resModName :: ModName -> ModName
-resModName = ('#':)
-
--- to get imports without parsing the whole files
-
-getImports :: [InitPath] -> FileName -> IOE [(ModuleHeader,InitPath)]
-getImports ps = get [] where
-  get ds file0 = do
-    let name = dropExtension file0 ---- dropExtension file0
-    (p,s) <- tryRead name
-    let ((typ,mname),imps) = importsOfFile s
-    let namebody = takeFileName name
-    ioeErr $ testErr  (mname == namebody) $ 
-             "module name" +++ mname +++ "differs from file name" +++ namebody
-    case imps of
-      _ | elem name (map (snd . fst . fst) ds) -> return ds  --- file already read
-      [] -> return $ (((typ,name),[]),p):ds
-      _ -> do
-        let files = map (gfFile . fst) imps 
-        foldM get ((((typ,name),imps),p):ds) files
-  tryRead name = do
-    file <- do
-      let file_gf = gfFile name
-      b <- doesFileExistPath ps file_gf                 -- try gf file first
-      if b then return file_gf else do
-        let file_gfr = gfrFile name
-        bb <- doesFileExistPath ps file_gfr             -- gfr file next
-        if bb then return file_gfr else do
-          return (gfcFile name)                         -- gfc next
-
-    readFileIfPath ps $ file
-
-
-
--- internal module dep information
-
-data ModUse =
-   MUReuse
- | MUInstance
- | MUComplete
- | MUOther
-  deriving (Eq,Show)
-
-data ModTyp =
-   MTyResource
- | MTyIncomplete
- | MTyIncResource -- interface, incomplete resource
- | MTyOther
-  deriving (Eq,Show)
-
-type ModuleHeader = ((ModTyp,ModName),[(ModName,ModUse)])
-
-importsOfFile :: String -> ModuleHeader
-importsOfFile = 
-  getModuleHeader .          -- analyse into mod header
-  filter (not . spec) .      -- ignore keywords and special symbols
-  unqual .                   -- take away qualifiers
-  unrestr .                  -- take away union restrictions
-  takeWhile (not . term) .   -- read until curly or semic
-  lexs .                     -- analyse into lexical tokens
-  unComm                     -- ignore comments before the headed line
- where
-    term = flip elem ["{",";"]
-    spec = flip elem ["of", "open","in",":", "->","=", "-","(", ")",",","**","union"]
-    unqual ws = case ws of
-      "(":q:ws' -> unqual ws'
-      w:ws' -> w:unqual ws'
-      _ -> ws
-    unrestr ws = case ws of
-      "[":ws' -> unrestr $ tail $ dropWhile (/="]") ws'
-      w:ws' -> w:unrestr ws'
-      _ -> ws
-
-getModuleHeader :: [String] -> ModuleHeader -- with, reuse
-getModuleHeader ws = case ws of
-  "incomplete":ws2 -> let ((ty,name),us) = getModuleHeader ws2 in
-    case ty of
-      MTyResource -> ((MTyIncResource,name),us)
-      _ -> ((MTyIncomplete,name),us)
-  "interface":ws2 -> let ((_,name),us) = getModuleHeader ("resource":ws2) in
-    ((MTyIncResource,name),us)
- 
-  "resource":name:ws2 -> case ws2 of
-    "reuse":m:_ -> ((MTyResource,name),[(m,MUReuse)])
-    m:"with":ms -> ((MTyResource,name),(m,MUOther):[(n,MUComplete) | n <- ms])
-    ms -> ((MTyResource,name),[(n,MUOther) | n <- ms])
-
-  "instance":name:m:ws2 -> case ws2 of
-    "reuse":n:_ -> ((MTyResource,name),(m,MUInstance):[(n,MUReuse)])
-    n:"with":ms -> 
-      ((MTyResource,name),(m,MUInstance):(n,MUComplete):[(n,MUOther) | n <- ms])
-    ms -> ((MTyResource,name),(m,MUInstance):[(n,MUOther) | n <- ms])
-
-  "concrete":name:a:ws2 -> case span (/= "with") ws2 of
-
-    (es,_:ms) -> ((MTyOther,name),
-                  [(m,MUOther)    | m <- es] ++
-                  [(n,MUComplete) | n <- ms])
-    --- m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
-    (ms,[]) -> ((MTyOther,name),[(n,MUOther) | n <- a:ms])
-
-  _:name:ws2 -> case ws2 of
-    "reuse":m:_ -> ((MTyOther,name),[(m,MUReuse)])
-    ---- m:n:"with":ms -> 
-    ----  ((MTyOther,name),(m,MUInstance):(n,MUOther):[(n,MUComplete) | n <- ms])
-    m:"with":ms -> ((MTyOther,name),(m,MUOther):[(n,MUComplete) | n <- ms])
-    ms -> ((MTyOther,name),[(n,MUOther) | n <- ms])
-  _ -> error "the file is empty"
-
-unComm s = case s of
-      '-':'-':cs -> unComm $ dropWhile (/='\n') cs
-      '{':'-':cs -> dpComm cs
-      c:cs -> c : unComm cs
-      _ -> s
-    
-dpComm s = case s of
-      '-':'}':cs -> unComm cs
-      c:cs -> dpComm cs
-      _ -> s
-    
-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
-getOptionsFromFile ::  FilePath -> IO Options
-getOptionsFromFile file = do
-  s <- readFileIfStrict file
-  let ls = filter (isPrefixOf "--#") $ lines s
-  return $ fst $ getOptions "-" $ map (unwords . words . drop 3) ls
-
--- | check if old GF file
-isOldFile :: FilePath -> IO Bool
-isOldFile f = do
-  s <- readFileIfStrict f
-  let s' = unComm s
-  return $ not (null s') && old (head (words s'))
- where
-   old = flip elem $ words 
-     "cat category data def flags fun include lin lincat lindef lintype oper param pattern printname rule"
-
-
-
--- | old GF tolerated newlines in quotes. No more supported!
-fixNewlines :: String -> String
-fixNewlines s = case s of
-     '"':cs -> '"':mk cs
-     c  :cs -> c:fixNewlines cs
-     _ -> s
- where
-   mk s = case s of
-     '\\':'"':cs -> '\\':'"': mk cs
-     '"'     :cs -> '"' :fixNewlines cs
-     '\n'    :cs -> '\\':'n': mk cs
-     c       :cs -> c : mk cs
-     _ -> s 
-
diff --git a/src-3.0/GF/Infra/UseIO.hs b/src-3.0/GF/Infra/UseIO.hs
deleted file mode 100644
index 4125a0417..000000000
--- a/src-3.0/GF/Infra/UseIO.hs
+++ /dev/null
@@ -1,330 +0,0 @@
-{-# OPTIONS -cpp #-}
-----------------------------------------------------------------------
--- |
--- Module      : UseIO
--- Maintainer  : AR
--- Stability   : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/08/08 09:01:25 $ 
--- > CVS $Author: peb $
--- > CVS $Revision: 1.17 $
---
--- (Description of the module)
------------------------------------------------------------------------------
-
-module GF.Infra.UseIO where
-
-import GF.Data.Operations
-import GF.System.Arch (prCPU)
-import GF.Infra.Option
-import GF.Today (libdir)
-
-import System.Directory
-import System.IO
-import System.IO.Error
-import System.Environment
-import System.FilePath
-import Control.Monad
-
-#ifdef mingw32_HOST_OS
-import System.Win32.DLL
-import Foreign.Ptr
-#endif
-
-
-putShow' :: Show a => (c -> a) -> c -> IO ()
-putShow' f = putStrLn . show . length . show . f
-
-putIfVerb :: Options -> String -> IO ()
-putIfVerb opts msg =
-      if oElem beVerbose opts
-         then putStrLn msg
-         else return ()
-
-putIfVerbW :: Options -> String -> IO ()
-putIfVerbW opts msg =
-      if oElem beVerbose opts
-         then putStr (' ' : msg)
-         else return ()
-
--- | obsolete with IOE monad
-errIO :: a -> Err a -> IO a
-errIO = errOptIO noOptions
-
-errOptIO :: Options -> a -> Err a -> IO a
-errOptIO os e m = case m of
-  Ok x  -> return x
-  Bad k -> do  
-    putIfVerb os k
-    return e
-
-prOptCPU :: Options -> Integer -> IO Integer
-prOptCPU opts = if (oElem noCPU opts) then (const (return 0)) else prCPU
-
-putCPU :: IO ()
-putCPU = do 
-  prCPU 0 
-  return ()
-
-putPoint :: Show a => Options -> String -> IO a -> IO a
-putPoint = putPoint' id
-
-putPoint' :: Show a => (c -> a) -> Options -> String -> IO c -> IO c
-putPoint' f opts msg act = do
-  let sil x = if oElem beSilent opts then return () else x
-      ve  x = if oElem beVerbose opts then x else return ()
-  ve $ putStrLn msg
-  a <- act
-  ve $ putShow' f a
-  ve $ putCPU
-  return a
-
-readFileStrict :: String -> IO String
-readFileStrict f = do
-  s <- readFile f
-  return $ seq (length s) ()
-  return s
-
-readFileIf = readFileIfs readFile
-readFileIfStrict  = readFileIfs readFileStrict
-
-readFileIfs rf f = catch (rf f) (\_ -> reportOn f) where
- reportOn f = do
-   putStrLnFlush ("File " ++ f ++ " does not exist. Returned empty string")
-   return ""
-
-type FileName = String
-type InitPath = String
-type FullPath = String
-
-getFilePath :: [FilePath] -> String -> IO (Maybe FilePath)
-getFilePath ps file = do
-  getFilePathMsg ("file" +++ file +++ "not found\n") ps file
-
-getFilePathMsg :: String -> [FilePath] -> String -> IO (Maybe FilePath)
-getFilePathMsg msg paths file = get paths where
-  get []     = putStrFlush msg >> return Nothing
-  get (p:ps) = do
-    let pfile = p </> file
-    exist <- doesFileExist pfile
-    if exist then return (Just pfile) else get ps
----               catch (readFileStrict pfile >> return (Just pfile)) (\_ -> get ps)
-
-readFileIfPath :: [FilePath] -> String -> IOE (FilePath,String)
-readFileIfPath paths file = do
-  mpfile <- ioeIO $ getFilePath paths file
-  case mpfile of
-    Just pfile -> do
-      s <- ioeIO $ readFileStrict pfile
-      return (dropFileName pfile,s)
-    _ -> ioeErr $ Bad ("File " ++ file ++ " does not exist.")
-
-doesFileExistPath :: [FilePath] -> String -> IOE Bool
-doesFileExistPath paths file = do
-  mpfile <- ioeIO $ getFilePathMsg "" paths file
-  return $ maybe False (const True) mpfile
-
-gfLibraryPath    = "GF_LIB_PATH"
-
--- | environment variable for grammar search path
-gfGrammarPathVar = "GF_GRAMMAR_PATH"
-
-getLibraryPath :: IO FilePath
-getLibraryPath =
-  catch
-    (getEnv gfLibraryPath)
-#ifdef mingw32_HOST_OS
-    (\_ -> do exepath <- getModuleFileName nullPtr
-              let (path,_) = splitFileName exepath
-              canonicalizePath (combine path "../lib"))
-#else
-    (const (return libdir))
-#endif
-
--- | extends the search path with the
--- 'gfLibraryPath' and 'gfGrammarPathVar'
--- environment variables. Returns only existing paths.
-extendPathEnv :: [FilePath] -> IO [FilePath]
-extendPathEnv ps = do
-  b <- getLibraryPath                             -- e.g. GF_LIB_PATH
-  s <- catch (getEnv gfGrammarPathVar) (const (return ""))     -- e.g. GF_GRAMMAR_PATH
-  let ss = ps ++ splitSearchPath s
-  liftM concat $ mapM allSubdirs $ ss ++ [b </> s | s <- ss ++ ["prelude"]]
-  where
-    allSubdirs :: FilePath -> IO [FilePath]
-    allSubdirs [] = return [[]]
-    allSubdirs p = case last p of
-      '*' -> do let path = init p
-                fs <- getSubdirs path
-                return [path </> f | f <- fs]
-      _   -> do exists <- doesDirectoryExist p
-                if exists
-                  then return [p]
-                  else return []
-
-getSubdirs :: FilePath -> IO [FilePath]
-getSubdirs dir = do
-  fs  <- catch (getDirectoryContents dir) (const $ return [])
-  foldM (\fs f -> do let fpath = dir </> f
-                     p <- getPermissions fpath
-                     if searchable p && not (take 1 f==".")
-                       then return (fpath:fs)
-                       else return        fs ) [] fs
-
-justModuleName :: FilePath -> String
-justModuleName = dropExtension . takeFileName
-
-splitInModuleSearchPath :: String -> [FilePath]
-splitInModuleSearchPath s = case break isPathSep s of
-  (f,_:cs) -> f : splitInModuleSearchPath cs
-  (f,_)    -> [f]
-  where
-    isPathSep :: Char -> Bool
-    isPathSep c = c == ':' || c == ';'
-
---
-
-getLineWell :: IO String -> IO String
-getLineWell ios = 
-  catch getLine (\e -> if (isEOFError e) then ios else ioError e)
-
-putStrFlush :: String -> IO ()
-putStrFlush s = putStr s >> hFlush stdout
-
-putStrLnFlush :: String -> IO ()
-putStrLnFlush s = putStrLn s >> hFlush stdout
-
--- * a generic quiz session
-
-type QuestionsAndAnswers = [(String, String -> (Integer,String))]
-
-teachDialogue :: QuestionsAndAnswers -> String -> IO ()
-teachDialogue qas welc = do
-  putStrLn $ welc ++++ genericTeachWelcome
-  teach (0,0) qas
- where 
-    teach _ [] = do putStrLn "Sorry, ran out of problems"
-    teach (score,total) ((question,grade):quas) = do
-      putStr ("\n" ++ question ++ "\n> ") 
-      answer <- getLine
-      if (answer == ".") then return () else do
-        let (result, feedback) = grade answer
-            score' = score + result 
-            total' = total + 1
-        putStr (feedback ++++ "Score" +++ show score' ++ "/" ++ show total')
-        if (total' > 9 && fromInteger score' / fromInteger total' >= 0.75)
-           then do putStrLn "\nCongratulations - you passed!"
-           else teach (score',total') quas
-
-    genericTeachWelcome = 
-      "The quiz is over when you have done at least 10 examples" ++++
-      "with at least 75 % success." +++++
-      "You can interrupt the quiz by entering a line consisting of a dot ('.').\n"
-
-
--- * IO monad with error; adapted from state monad
-
-newtype IOE a = IOE (IO (Err a))
-
-appIOE :: IOE a -> IO (Err a)
-appIOE (IOE iea) = iea
-
-ioe :: IO (Err a) -> IOE a
-ioe = IOE
-
-ioeIO :: IO a -> IOE a
-ioeIO io = ioe (io >>= return . return)
-
-ioeErr :: Err a -> IOE a
-ioeErr = ioe . return 
-
-instance  Monad IOE where
-  return a    = ioe (return (return a))
-  IOE c >>= f = IOE $ do 
-                  x <- c          -- Err a
-                  appIOE $ err ioeBad f x         -- f :: a -> IOE a
-
-ioeBad :: String -> IOE a
-ioeBad = ioe . return . Bad
-
-useIOE :: a -> IOE a -> IO a
-useIOE a ioe = appIOE ioe >>= err (\s -> putStrLn s >> return a) return 
-
-foldIOE :: (a -> b -> IOE a) -> a -> [b] -> IOE (a, Maybe String)
-foldIOE f s xs = case xs of
-  [] -> return (s,Nothing)
-  x:xx -> do
-    ev <- ioeIO $ appIOE (f s x) 
-    case ev of 
-      Ok v  -> foldIOE f v xx
-      Bad m -> return $ (s, Just m)
-
-putStrLnE :: String -> IOE ()
-putStrLnE = ioeIO . putStrLnFlush 
-
-putStrE :: String -> IOE ()
-putStrE = ioeIO . putStrFlush 
-
--- this is more verbose
-putPointE :: Options -> String -> IOE a -> IOE a
-putPointE = putPointEgen (oElem beSilent)
-
--- this is less verbose
-putPointEsil :: Options -> String -> IOE a -> IOE a
-putPointEsil = putPointEgen (not . oElem beVerbose)
-
-putPointEgen :: (Options -> Bool) -> Options -> String -> IOE a -> IOE a
-putPointEgen cond opts msg act = do
-  let ve x = if cond opts then return () else x
-  ve $ ioeIO $ putStrFlush msg
-  a <- act
----  ve $ ioeIO $ putShow' id a --- replace by a statistics command
-  ve $ ioeIO $ putStrFlush " "
-  ve $ ioeIO $ putCPU
-  return a
-{-
-putPointE :: Options -> String -> IOE a -> IOE a
-putPointE opts msg act = do
-  let ve x = if oElem beVerbose opts then x else return ()
-  ve $ putStrE msg
-  a <- act
----  ve $ ioeIO $ putShow' id a --- replace by a statistics command
-  ve $ ioeIO $ putCPU
-  return a
--}
-
--- | forces verbosity
-putPointEVerb :: Options -> String -> IOE a -> IOE a
-putPointEVerb opts = putPointE (addOption beVerbose opts)
-
--- ((do {s <- readFile f; return (return s)}) ) 
-readFileIOE :: FilePath -> IOE (String)
-readFileIOE f = ioe $ catch (readFileStrict f >>= return . return)
-                            (\e -> return (Bad (show e)))
-
--- | 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)
-readFileLibraryIOE ini f = ioe $ do
-  lp <- getLibraryPath
-  tryRead ini $ \_ ->
-    tryRead lp  $ \e ->
-      return (Bad (show e))
-  where
-    tryRead path onError =
-      catch (readFileStrict fpath >>= \s -> return (return (fpath,s)))
-            onError
-      where
-        fpath = path </> f
-
--- | example
-koeIOE :: IO ()
-koeIOE = useIOE () $ do
-  s  <- ioeIO  $ getLine
-  s2 <- ioeErr $ mapM (!? 2) $ words s
-  ioeIO $ putStrLn s2
-