/ - Diff - snf-ganeti - Greek Research and Technology Network's projects

       , goodMatchPriority
       , prefixMatch
       , compareNameComponent
       , ListSet(..)
       , emptyListSet
       ) where
     import Control.Applicative
-...
     import Control.Monad.Trans
     import Data.Function
     import Data.List
     import Data.Set (Set)
     import qualified Data.Set as Set (empty)
     import Text.JSON (JSON)
     import qualified Text.JSON as JSON (readJSON, showJSON)
     -- | Generic monad for our error handling mechanisms.
     data GenericResult a b
-...
                -> LookupResult  -- ^ Result of the lookup
     lookupName l s = foldr (chooseLookupResult s)
                            (LookupResult FailMatch s) l
     -- | Wrapper for a Haskell 'Set'
     --
     -- This type wraps a 'Set' and it is used in the Haskell to Python
     -- opcode generation to transform a Haskell 'Set' into a Python 'list'
     -- without duplicate elements.
     newtype ListSet a = ListSet { unListSet :: Set a }
       deriving (Eq, Show)
     instance (Ord a, JSON a) => JSON (ListSet a) where
       showJSON = JSON.showJSON . unListSet
       readJSON = liftM ListSet . JSON.readJSON
     emptyListSet :: ListSet a
     emptyListSet = ListSet Set.empty

       ) where
     import Control.Monad (liftM)
     import Data.Set (Set)
     import qualified Data.Set as Set
     import Text.JSON (JSON, JSValue(..), JSObject (..), readJSON, showJSON,
                       fromJSString, toJSObject)
     import qualified Text.JSON
-...
     import Ganeti.Types
     import qualified Ganeti.Query.Language as Qlang
     -- * Helper functions and types
     -- | Build a boolean field.
-...
       showJSON (ExportTargetRemote l) = showJSON l
       readJSON = readExportTarget
     -- * Common opcode parameters
     pDryRun :: Field
-...
       withDoc "Reason trail field" $
       simpleField C.opcodeReason [t| ReasonTrail |]
     -- * Parameters
     pDebugSimulateErrors :: Field
-...
     pSkipChecks :: Field
     pSkipChecks =
       withDoc "Which checks to skip" .
       defaultField [| Set.empty |] $
       simpleField "skip_checks" [t| Set VerifyOptionalChecks |]
       defaultField [| emptyListSet |] $
       simpleField "skip_checks" [t| ListSet VerifyOptionalChecks |]
     pIgnoreErrors :: Field
     pIgnoreErrors =
       withDoc "List of error codes that should be treated as warnings" .
       defaultField [| Set.empty |] $
       simpleField "ignore_errors" [t| Set CVErrorCode |]
       defaultField [| emptyListSet |] $
       simpleField "ignore_errors" [t| ListSet CVErrorCode |]
     pVerbose :: Field
     pVerbose =

     import Data.List (intercalate)
     import Data.Map (Map)
     import qualified Data.Map as Map
     import Data.Set (Set)
     import qualified Data.Set as Set
     import qualified Data.Set as Set (toList)
     import Ganeti.BasicTypes
     import Ganeti.THH
     instance PyValue Bool
-...
         "{" ++ intercalate ", " (map showPair (Map.assocs mp)) ++ "}"
         where showPair (k, x) = show k ++ ":" ++ show x
     instance PyValue a => PyValue (Set a) where
       showValue s = showValue (Set.toList s)
     instance PyValue a => PyValue (ListSet a) where
       showValue = showValue . Set.toList . unListSet

           "OP_CLUSTER_QUERY" -> pure OpCodes.OpClusterQuery
           "OP_CLUSTER_VERIFY" ->
             OpCodes.OpClusterVerify <$> arbitrary <*> arbitrary <*>
               genSet Nothing <*> genSet Nothing <*> arbitrary <*>
               genListSet Nothing <*> genListSet Nothing <*> arbitrary <*>
               genMaybe genNameNE
           "OP_CLUSTER_VERIFY_CONFIG" ->
             OpCodes.OpClusterVerifyConfig <$> arbitrary <*> arbitrary <*>
               genSet Nothing <*> arbitrary
               genListSet Nothing <*> arbitrary
           "OP_CLUSTER_VERIFY_GROUP" ->
             OpCodes.OpClusterVerifyGroup <$> genNameNE <*> arbitrary <*>
               arbitrary <*> genSet Nothing <*> genSet Nothing <*> arbitrary
               arbitrary <*> genListSet Nothing <*> genListSet Nothing <*> arbitrary
           "OP_CLUSTER_VERIFY_DISKS" -> pure OpCodes.OpClusterVerifyDisks
           "OP_GROUP_VERIFY_DISKS" ->
             OpCodes.OpGroupVerifyDisks <$> genNameNE

       , SmallRatio(..)
       , genSetHelper
       , genSet
       , genListSet
       , genIPv4Address
       , genIPv4Network
       , genIp6Addr
-...
                newelem <- elements candidates `suchThat` (`Set.notMember` set)
                return (Set.insert newelem set)) Set.empty [1..size']
     -- | Generates a set of arbitrary elements.
     -- | Generates a 'Set' of arbitrary elements.
     genSet :: (Ord a, Bounded a, Enum a) => Maybe Int -> Gen (Set.Set a)
     genSet = genSetHelper [minBound..maxBound]
     -- | Generates a 'Set' of arbitrary elements wrapped in a 'ListSet'
     genListSet :: (Ord a, Bounded a, Enum a) => Maybe Int
                   -> Gen (BasicTypes.ListSet a)
     genListSet is = BasicTypes.ListSet <$> genSet is
     -- | Generate an arbitrary IPv4 address in textual form.
     genIPv4 :: Gen String
     genIPv4 = do

Synnefo » snf-ganeti