git-annex/Types/View.hs
Joey Hess f76c4a0973
avoid Arbitrary generating excessivly long lists
Turns what it was doing often generated too long lists, or spun with
suchThat rejecting too large numbers. Limit lists to 10.
2019-01-21 13:50:24 -04:00

60 lines
1.5 KiB
Haskell

{- types for metadata based branch views
-
- Copyright 2014 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Types.View where
import Annex.Common
import Types.MetaData
import Utility.QuickCheck
import qualified Git
import qualified Data.Set as S
{- A view is a list of fields with filters on their allowed values,
- which are applied to files in a parent git branch. -}
data View = View
{ viewParentBranch :: Git.Branch
, viewComponents :: [ViewComponent]
}
deriving (Eq, Read, Show)
instance Arbitrary View where
arbitrary = View (Git.Ref "master")
<$> resize 10 (listOf arbitrary)
data ViewComponent = ViewComponent
{ viewField :: MetaField
, viewFilter :: ViewFilter
, viewVisible :: Bool
}
deriving (Eq, Read, Show)
instance Arbitrary ViewComponent where
arbitrary = ViewComponent <$> arbitrary <*> arbitrary <*> arbitrary
data ViewFilter
= FilterValues (S.Set MetaValue)
| FilterGlob String
| ExcludeValues (S.Set MetaValue)
deriving (Eq, Read, Show)
instance Arbitrary ViewFilter where
arbitrary = do
s <- S.fromList <$> resize 10 (listOf arbitrary)
ifM arbitrary
( return (FilterValues s)
, return (ExcludeValues s)
)
mkViewComponent :: MetaField -> ViewFilter -> ViewComponent
mkViewComponent f vf = ViewComponent f vf (multiValue vf)
{- Can a ViewFilter match multiple different MetaValues? -}
multiValue :: ViewFilter -> Bool
multiValue (FilterValues s) = S.size s > 1
multiValue (FilterGlob _) = True
multiValue (ExcludeValues _) = False