DFudIO

{-# LANGUAGE CPP #-}
module DFudIO(Fudlogue,fudlogue, fudlogue', HasCache(..)) where

import FDefaults
import FudIO(fudIO1)
import Fudget
import Xtypes
--import Cache(allcacheF)
import NewCache(allcacheF)
import CmdLineEnv(argFlag)

{-
HBC uses "cpp -C -traditional" which causes all the  to be left behind
when the macro definitions are processed. That is why the definitions
are inside a comment.







  
-}

data Fudlogue = Pars [Pars]
data Pars = Cache Bool

class HasCache xxx where {    setCache :: (Bool) -> Customiser xxx;     getCache :: xxx -> (Bool);     getCacheMaybe :: xxx -> Maybe (Bool);     getCache = fromMaybe (error "get Cache: missing default") . getCacheMaybe }
instance HasCache (Fudlogue) where {  setCache p (Pars ps) = Pars (Cache p:ps);   getCacheMaybe (Pars ps) = getparMaybe (\x->case x of Cache p -> Just p; _-> Nothing) ps }

fudlogue = fudlogue' standard
fudlogue' :: Customiser Fudlogue -> F a b -> IO ()
fudlogue' pmod f = fudIO1 (cache f) where
   ps = pmod (Pars [Cache usecache])
   cache = if getCache ps then allcacheF else id


usecache = argFlag "cache" True