src/Ganeti/BasicTypes.hs

   1 {-# LANGUAGE FlexibleInstances #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE MultiParamTypeClasses #-}
   4 {-# LANGUAGE TypeFamilies #-}
   5 {-# LANGUAGE DeriveFunctor #-}
   6 {-# LANGUAGE UndecidableInstances #-}
   7 {-# LANGUAGE CPP #-}
   8
   9 {-
  10
  11 Copyright (C) 2009, 2010, 2011, 2012, 2015 Google Inc.
  12 All rights reserved.
  13
  14 Redistribution and use in source and binary forms, with or without
  15 modification, are permitted provided that the following conditions are
  16 met:
  17
  18 1. Redistributions of source code must retain the above copyright notice,
  19 this list of conditions and the following disclaimer.
  20
  21 2. Redistributions in binary form must reproduce the above copyright
  22 notice, this list of conditions and the following disclaimer in the
  23 documentation and/or other materials provided with the distribution.
  24
  25 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
  26 IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
  27 TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
  28 PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR
  29 CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  30 EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
  31 PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
  32 PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
  33 LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  34 NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  35 SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  36
  37 -}
  38
  39 module Ganeti.BasicTypes
  40   ( GenericResult(..)
  41   , genericResult
  42   , Result
  43   , ResultT(..)
  44   , mkResultT
  45   , mkResultT'
  46   , mkResultTEither
  47   , withError
  48   , withErrorT
  49   , toError
  50   , toErrorBase
  51   , toErrorStr
  52   , tryError
  53   , Error(..) -- re-export from Control.Monad.Error
  54   , MonadIO(..) -- re-export from Control.Monad.IO.Class
  55   , FromString(..)
  56   , isOk
  57   , isBad
  58   , justOk
  59   , justBad
  60   , eitherToResult
  61   , isLeft
  62   , isRight
  63   , annotateResult
  64   , annotateError
  65   , failError
  66   , catchErrorT
  67   , handleErrorT
  68   , orElse
  69   , iterateOk
  70   , select
  71   , runListHead
  72   , LookupResult(..)
  73   , MatchPriority(..)
  74   , lookupName
  75   , goodLookupResult
  76   , goodMatchPriority
  77   , prefixMatch
  78   , compareNameComponent
  79   , ListSet(..)
  80   , emptyListSet
  81   , Down(..)
  82   ) where
  83
  84 import Prelude ()
  85 import Ganeti.Prelude
  86
  87 import Control.Applicative
  88 import Control.Exception (try)
  89 import Control.Monad
  90 import Control.Monad.Base
  91 import Control.Monad.Error.Class
  92 import Control.Monad.Trans
  93 import Control.Monad.Trans.Control
  94 import Data.Function
  95 import Data.List (find, isPrefixOf)
  96 import Data.Maybe
  97 import Data.Set (Set)
  98 import qualified Data.Set as Set (empty)
  99 import Text.JSON (JSON)
 100 import qualified Text.JSON as JSON (readJSON, showJSON)
 101 #if MIN_VERSION_base(4,6,0)
 102 import Data.Ord
 103 #endif
 104
 105 -- Remove after we require >= 1.8.58
 106 -- See: https://github.com/ndmitchell/hlint/issues/24
 107 {-# ANN module "HLint: ignore Unused LANGUAGE pragma" #-}
 108
 109 -- | Generic monad for our error handling mechanisms.
 110 data GenericResult a b
 111   = Bad a
 112   | Ok b
 113     deriving (Show, Eq)
 114
 115 -- | Sum type structure of GenericResult.
 116 genericResult :: (a -> c) -> (b -> c) -> GenericResult a b -> c
 117 genericResult f _ (Bad a) = f a
 118 genericResult _ g (Ok b) = g b
 119 {-# INLINE genericResult #-}
 120
 121 -- | Type alias for a string Result.
 122 type Result = GenericResult String
 123
 124 -- | Type class for things that can be built from strings.
 125 class FromString a where
 126   mkFromString :: String -> a
 127
 128 -- | Trivial 'String' instance; requires FlexibleInstances extension
 129 -- though.
 130 instance FromString [Char] where
 131   mkFromString = id
 132
 133 instance FromString IOError where
 134   mkFromString = userError
 135
 136 -- | 'Monad' instance for 'GenericResult'.
 137 instance (FromString a) => Monad (GenericResult a) where
 138   (>>=) (Bad x) _ = Bad x
 139   (>>=) (Ok x) fn = fn x
 140   return = Ok
 141   fail   = Bad . mkFromString
 142
 143 instance Functor (GenericResult a) where
 144   fmap _ (Bad msg) = Bad msg
 145   fmap fn (Ok val) = Ok (fn val)
 146
 147 instance (FromString a, Monoid a) => Alternative (GenericResult a) where
 148   empty = Bad $ mkFromString "zero Result when used as empty"
 149   -- for mplus, when we 'add' two Bad values, we concatenate their
 150   -- error descriptions
 151   (Bad x) <|> (Bad y) = Bad (x `mappend` mkFromString "; " `mappend` y)
 152   (Bad _) <|> x = x
 153   x@(Ok _) <|> _ = x
 154
 155 instance (FromString a, Monoid a) => MonadPlus (GenericResult a) where
 156   mzero = empty
 157   mplus = (<|>)
 158
 159 instance (FromString a) => MonadError a (GenericResult a) where
 160   throwError = Bad
 161   {-# INLINE throwError #-}
 162   catchError x h = genericResult h (const x) x
 163   {-# INLINE catchError #-}
 164
 165 instance Applicative (GenericResult a) where
 166   pure = Ok
 167   (Bad f) <*> _       = Bad f
 168   _       <*> (Bad x) = Bad x
 169   (Ok f)  <*> (Ok x)  = Ok $ f x
 170
 171 -- | This is a monad transformation for Result. It's implementation is
 172 -- based on the implementations of MaybeT and ErrorT.
 173 --
 174 -- 'ResultT' is very similar to @ErrorT@, but with one subtle difference:
 175 -- If 'mplus' combines two failing operations, errors of both of them
 176 -- are combined.
 177 newtype ResultT a m b = ResultT {runResultT :: m (GenericResult a b)}
 178
 179 -- | Eliminates a 'ResultT' value given appropriate continuations
 180 elimResultT :: (Monad m)
 181             => (a -> ResultT a' m b')
 182             -> (b -> ResultT a' m b')
 183             -> ResultT a m b
 184             -> ResultT a' m b'
 185 elimResultT l r = ResultT . (runResultT . result <=< runResultT)
 186   where
 187     result (Ok x)   = r x
 188     result (Bad e)  = l e
 189 {-# INLINE elimResultT #-}
 190
 191 instance (Monad m) => Functor (ResultT a m) where
 192   fmap f = ResultT . liftM (fmap f) . runResultT
 193
 194 instance (Monad m, FromString a) => Applicative (ResultT a m) where
 195   pure = return
 196   (<*>) = ap
 197
 198 instance (Monad m, FromString a) => Monad (ResultT a m) where
 199   fail err = ResultT (return . Bad $ mkFromString err)
 200   return   = lift . return
 201   (>>=)    = flip (elimResultT throwError)
 202
 203 instance (Monad m, FromString a) => MonadError a (ResultT a m) where
 204   throwError = ResultT . return . Bad
 205   catchError = catchErrorT
 206
 207 instance MonadTrans (ResultT a) where
 208   lift = ResultT . liftM Ok
 209
 210 -- | The instance catches any 'IOError' using 'try' and converts it into an
 211 -- error message using 'mkFromString'.
 212 --
 213 -- This way, monadic code within 'ResultT' that uses solely 'liftIO' to
 214 -- include 'IO' actions ensures that all IO exceptions are handled.
 215 --
 216 -- Other exceptions (see instances of 'Exception') are not currently handled.
 217 -- This might be revised in the future.
 218 instance (MonadIO m, FromString a) => MonadIO (ResultT a m) where
 219   liftIO = ResultT . liftIO
 220                    . liftM (either (failError . show) return)
 221                    . (try :: IO a -> IO (Either IOError a))
 222
 223 instance (MonadBase IO m, FromString a) => MonadBase IO (ResultT a m) where
 224   liftBase = ResultT . liftBase
 225                    . liftM (either (failError . show) return)
 226                    . (try :: IO a -> IO (Either IOError a))
 227
 228 instance (FromString a) => MonadTransControl (ResultT a) where
 229 #if MIN_VERSION_monad_control(1,0,0)
 230 -- Needs Undecidable instances
 231   type StT (ResultT a) b = GenericResult a b
 232   liftWith f = ResultT . liftM return $ f runResultT
 233   restoreT = ResultT
 234 #else
 235   newtype StT (ResultT a) b = StResultT { runStResultT :: GenericResult a b }
 236   liftWith f = ResultT . liftM return $ f (liftM StResultT . runResultT)
 237   restoreT = ResultT . liftM runStResultT
 238 #endif
 239   {-# INLINE liftWith #-}
 240   {-# INLINE restoreT #-}
 241
 242 instance (FromString a, MonadBaseControl IO m)
 243          => MonadBaseControl IO (ResultT a m) where
 244 #if MIN_VERSION_monad_control(1,0,0)
 245 -- Needs Undecidable instances
 246   type StM (ResultT a m) b
 247     = ComposeSt (ResultT a) m b
 248   liftBaseWith = defaultLiftBaseWith
 249   restoreM = defaultRestoreM
 250 #else
 251   newtype StM (ResultT a m) b
 252     = StMResultT { runStMResultT :: ComposeSt (ResultT a) m b }
 253   liftBaseWith = defaultLiftBaseWith StMResultT
 254   restoreM = defaultRestoreM runStMResultT
 255 #endif
 256   {-# INLINE liftBaseWith #-}
 257   {-# INLINE restoreM #-}
 258
 259 instance (Monad m, FromString a, Monoid a)
 260          => Alternative (ResultT a m) where
 261   empty = ResultT $ return mzero
 262   -- Ensure that 'y' isn't run if 'x' contains a value. This makes it a bit
 263   -- more complicated than 'mplus' of 'GenericResult'.
 264   x <|> y = elimResultT combine return x
 265     where combine x' = ResultT $ liftM (mplus (Bad x')) (runResultT y)
 266
 267 instance (Monad m, FromString a, Monoid a)
 268          => MonadPlus (ResultT a m) where
 269   mzero = empty
 270   mplus = (<|>)
 271
 272 -- | Changes the error message of a result value, if present.
 273 -- Note that since 'GenericResult' is also a 'MonadError', this function
 274 -- is a generalization of
 275 -- @(Error e') => (e' -> e) -> GenericResult e' a -> GenericResult e a@
 276 withError :: (MonadError e m) => (e' -> e) -> GenericResult e' a -> m a
 277 withError f = genericResult (throwError . f) return
 278
 279 -- | Changes the error message of a @ResultT@ value, if present.
 280 withErrorT :: (Monad m, FromString e)
 281            => (e' -> e) -> ResultT e' m a -> ResultT e m a
 282 withErrorT f = ResultT . liftM (withError f) . runResultT
 283
 284 -- | Lift a 'Result' value to any 'MonadError'. Since 'ResultT' is itself its
 285 -- instance, it's a generalization of
 286 -- @Monad m => GenericResult a b -> ResultT a m b@.
 287 toError :: (MonadError e m) => GenericResult e a -> m a
 288 toError = genericResult throwError return
 289 {-# INLINE toError #-}
 290
 291 -- | Lift a 'ResultT' value into any 'MonadError' with the same base monad.
 292 toErrorBase :: (MonadBase b m, MonadError e m) => ResultT e b a -> m a
 293 toErrorBase = (toError =<<) . liftBase . runResultT
 294 {-# INLINE toErrorBase #-}
 295
 296 -- | An alias for @withError mkFromString@, which is often
 297 -- used to lift a pure error to a monad stack. See also 'annotateResult'.
 298 toErrorStr :: (MonadError e m, FromString e) => Result a -> m a
 299 toErrorStr = withError mkFromString
 300
 301 -- | Run a given computation and if an error occurs, return it as `Left` of
 302 -- `Either`.
 303 -- This is a generalized version of 'try'.
 304 tryError :: (MonadError e m) => m a -> m (Either e a)
 305 tryError = flip catchError (return . Left) . liftM Right
 306 {-# INLINE tryError #-}
 307
 308 -- | Converts a monadic result with a 'String' message into
 309 -- a 'ResultT' with an arbitrary 'Error'.
 310 --
 311 -- Expects that the given action has already taken care of any possible
 312 -- errors. In particular, if applied on @IO (Result a)@, any exceptions
 313 -- should be handled by the given action.
 314 --
 315 -- See also 'toErrorStr'.
 316 mkResultT :: (Monad m, FromString e) => m (Result a) -> ResultT e m a
 317 mkResultT = ResultT . liftM toErrorStr
 318
 319 -- | Generalisation of mkResultT accepting any showable failures.
 320 mkResultT' :: (Monad m, FromString e, Show s)
 321            => m (GenericResult s a) -> ResultT e m a
 322 mkResultT' = mkResultT . liftM (genericResult (Bad . show) Ok)
 323
 324 -- | Generalisation of mkResultT accepting any showable failures.
 325 mkResultTEither :: (Monad m, FromString e, Show s)
 326            => m (Either s a) -> ResultT e m a
 327 mkResultTEither = mkResultT . liftM (either (Bad . show) Ok)
 328
 329 -- | Simple checker for whether a 'GenericResult' is OK.
 330 isOk :: GenericResult a b -> Bool
 331 isOk (Ok _) = True
 332 isOk _      = False
 333
 334 -- | Simple checker for whether a 'GenericResult' is a failure.
 335 isBad :: GenericResult a b -> Bool
 336 isBad = not . isOk
 337
 338 -- | Simple filter returning only OK values of GenericResult
 339 justOk :: [GenericResult a b] -> [b]
 340 justOk = mapMaybe (genericResult (const Nothing) Just)
 341
 342 -- | Simple filter returning only Bad values of GenericResult
 343 justBad :: [GenericResult a b] -> [a]
 344 justBad = mapMaybe (genericResult Just (const Nothing))
 345
 346 -- | Converter from Either to 'GenericResult'.
 347 eitherToResult :: Either a b -> GenericResult a b
 348 eitherToResult (Left  s) = Bad s
 349 eitherToResult (Right v) = Ok  v
 350
 351 -- | Check if an either is Left. Equivalent to isLeft from Data.Either
 352 -- version 4.7.0.0 or higher.
 353 isLeft :: Either a b -> Bool
 354 isLeft (Left _) = True
 355 isLeft _        = False
 356
 357 -- | Check if an either is Right. Equivalent to isRight from Data.Either
 358 -- version 4.7.0.0 or higher.
 359 isRight :: Either a b -> Bool
 360 isRight = not . isLeft
 361
 362 -- | Annotate an error with an ownership information, lifting it to a
 363 -- 'MonadError'. Since 'Result' is an instance of 'MonadError' itself,
 364 -- it's a generalization of type @String -> Result a -> Result a@.
 365 -- See also 'toErrorStr'.
 366 annotateResult :: (MonadError e m, FromString e) => String -> Result a -> m a
 367 annotateResult owner = toErrorStr . annotateError owner
 368
 369 -- | Annotate an error with an ownership information inside a 'MonadError'.
 370 -- See also 'annotateResult'.
 371 annotateError :: (MonadError e m, FromString e, Monoid e)
 372               => String -> m a -> m a
 373 annotateError owner =
 374   flip catchError (throwError . mappend (mkFromString $ owner ++ ": "))
 375 {-# INLINE annotateError #-}
 376
 377 -- | Throws a 'String' message as an error in a 'MonadError'.
 378 -- This is a generalization of 'Bad'.
 379 -- It's similar to 'fail', but works within a 'MonadError', avoiding the
 380 -- unsafe nature of 'fail'.
 381 failError :: (MonadError e m, FromString e) => String -> m a
 382 failError = throwError . mkFromString
 383
 384 -- | A synonym for @flip@ 'catchErrorT'.
 385 handleErrorT :: (Monad m, FromString e)
 386              => (e' -> ResultT e m a) -> ResultT e' m a -> ResultT e m a
 387 handleErrorT handler = elimResultT handler return
 388 {-# INLINE handleErrorT #-}
 389
 390 -- | Catches an error in a @ResultT@ value. This is similar to 'catchError',
 391 -- but in addition allows to change the error type.
 392 catchErrorT :: (Monad m, FromString e)
 393             => ResultT e' m a -> (e' -> ResultT e m a) -> ResultT e m a
 394 catchErrorT = flip handleErrorT
 395 {-# INLINE catchErrorT #-}
 396
 397 -- | If the first computation fails, run the second one.
 398 -- Unlike 'mplus' instance for 'ResultT', this doesn't require
 399 -- the 'Monoid' constrait.
 400 orElse :: (MonadError e m) => m a -> m a -> m a
 401 orElse x y = catchError x (const y)
 402
 403 -- | Iterate while Ok.
 404 iterateOk :: (a -> GenericResult b a) -> a -> [a]
 405 iterateOk f a = genericResult (const []) ((:) a . iterateOk f) (f a)
 406
 407 -- * Misc functionality
 408
 409 -- | Return the first result with a True condition, or the default otherwise.
 410 select :: a            -- ^ default result
 411        -> [(Bool, a)]  -- ^ list of \"condition, result\"
 412        -> a            -- ^ first result which has a True condition, or default
 413 select def = maybe def snd . find fst
 414
 415 -- | Apply a function to the first element of a list, return the default
 416 -- value, if the list is empty. This is just a convenient combination of
 417 -- maybe and listToMaybe.
 418 runListHead :: a -> (b -> a) -> [b] -> a
 419 runListHead a f = maybe a f . listToMaybe
 420
 421 -- * Lookup of partial names functionality
 422
 423 -- | The priority of a match in a lookup result.
 424 data MatchPriority = ExactMatch
 425                    | MultipleMatch
 426                    | PartialMatch
 427                    | FailMatch
 428                    deriving (Show, Enum, Eq, Ord)
 429
 430 -- | The result of a name lookup in a list.
 431 data LookupResult = LookupResult
 432   { lrMatchPriority :: MatchPriority -- ^ The result type
 433   -- | Matching value (for ExactMatch, PartialMatch), Lookup string otherwise
 434   , lrContent :: String
 435   } deriving (Show)
 436
 437 -- | Lookup results have an absolute preference ordering.
 438 instance Eq LookupResult where
 439   (==) = (==) `on` lrMatchPriority
 440
 441 instance Ord LookupResult where
 442   compare = compare `on` lrMatchPriority
 443
 444 -- | Check for prefix matches in names.
 445 -- Implemented in Ganeti core utils.text.MatchNameComponent
 446 -- as the regexp r"^%s(\..*)?$" % re.escape(key)
 447 prefixMatch :: String  -- ^ Lookup
 448             -> String  -- ^ Full name
 449             -> Bool    -- ^ Whether there is a prefix match
 450 prefixMatch = isPrefixOf . (++ ".")
 451
 452 -- | Is the lookup priority a "good" one?
 453 goodMatchPriority :: MatchPriority -> Bool
 454 goodMatchPriority ExactMatch = True
 455 goodMatchPriority PartialMatch = True
 456 goodMatchPriority _ = False
 457
 458 -- | Is the lookup result an actual match?
 459 goodLookupResult :: LookupResult -> Bool
 460 goodLookupResult = goodMatchPriority . lrMatchPriority
 461
 462 -- | Compares a canonical name and a lookup string.
 463 compareNameComponent :: String        -- ^ Canonical (target) name
 464                      -> String        -- ^ Partial (lookup) name
 465                      -> LookupResult  -- ^ Result of the lookup
 466 compareNameComponent cnl lkp =
 467   select (LookupResult FailMatch lkp)
 468   [ (cnl == lkp          , LookupResult ExactMatch cnl)
 469   , (prefixMatch lkp cnl , LookupResult PartialMatch cnl)
 470   ]
 471
 472 -- | Lookup a string and choose the best result.
 473 chooseLookupResult :: String       -- ^ Lookup key
 474                    -> String       -- ^ String to compare to the lookup key
 475                    -> LookupResult -- ^ Previous result
 476                    -> LookupResult -- ^ New result
 477 chooseLookupResult lkp cstr old =
 478   -- default: use class order to pick the minimum result
 479   select (min new old)
 480   -- special cases:
 481   -- short circuit if the new result is an exact match
 482   [ (lrMatchPriority new == ExactMatch, new)
 483   -- if both are partial matches generate a multiple match
 484   , (partial2, LookupResult MultipleMatch lkp)
 485   ] where new = compareNameComponent cstr lkp
 486           partial2 = all ((PartialMatch==) . lrMatchPriority) [old, new]
 487
 488 -- | Find the canonical name for a lookup string in a list of names.
 489 lookupName :: [String]      -- ^ List of keys
 490            -> String        -- ^ Lookup string
 491            -> LookupResult  -- ^ Result of the lookup
 492 lookupName l s = foldr (chooseLookupResult s)
 493                        (LookupResult FailMatch s) l
 494
 495 -- | Wrapper for a Haskell 'Set'
 496 --
 497 -- This type wraps a 'Set' and it is used in the Haskell to Python
 498 -- opcode generation to transform a Haskell 'Set' into a Python 'list'
 499 -- without duplicate elements.
 500 newtype ListSet a = ListSet { unListSet :: Set a }
 501   deriving (Eq, Show, Ord)
 502
 503 instance (Ord a, JSON a) => JSON (ListSet a) where
 504   showJSON = JSON.showJSON . unListSet
 505   readJSON = liftM ListSet . JSON.readJSON
 506
 507 emptyListSet :: ListSet a
 508 emptyListSet = ListSet Set.empty
 509
 510 #if MIN_VERSION_base(4,6,0)
 511 -- Down already defined in Data.Ord
 512 #else
 513 -- Copyright   :  (c) The University of Glasgow 2005
 514 -- License     :  BSD-style
 515
 516 newtype Down a = Down a deriving (Eq, Show, Read)
 517
 518 instance Ord a => Ord (Down a) where
 519     compare (Down x) (Down y) = y `compare` x
 520
 521 {- License text of the above code fragment:
 522
 523 The Glasgow Haskell Compiler License
 524
 525 Copyright 2004, The University Court of the University of Glasgow.
 526 All rights reserved.
 527
 528 Redistribution and use in source and binary forms, with or without
 529 modification, are permitted provided that the following conditions are met:
 530
 531 - Redistributions of source code must retain the above copyright notice,
 532 this list of conditions and the following disclaimer.
 533
 534 - Redistributions in binary form must reproduce the above copyright notice,
 535 this list of conditions and the following disclaimer in the documentation
 536 and/or other materials provided with the distribution.
 537
 538 - Neither name of the University nor the names of its contributors may be
 539 used to endorse or promote products derived from this software without
 540 specific prior written permission.
 541
 542 THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
 543 GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
 544 INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
 545 FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
 546 UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
 547 FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 548 DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 549 SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 550 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 551 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 552 OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
 553 DAMAGE.
 554
 555 -}
 556
 557 #endif