diff options
| -rw-r--r-- | Annex/View.hs | 89 | ||||
| -rw-r--r-- | Types/View.hs | 71 |
2 files changed, 95 insertions, 65 deletions
diff --git a/Annex/View.hs b/Annex/View.hs index aef9e0a66..890f2682a 100644 --- a/Annex/View.hs +++ b/Annex/View.hs @@ -10,15 +10,13 @@ module Annex.View where import Common.Annex -import Logs.MetaData +import Types.View import Types.MetaData import qualified Git.Types as Git import qualified Git.Ref import qualified Git.DiffTree import qualified Git.Branch -import qualified Git.Index import Git.Sha (nullSha) -import Utility.QuickCheck import qualified Data.Set as S import Data.Char @@ -31,42 +29,6 @@ import Text.Regex.TDFA.String #else #endif -type View = [(MetaField, ViewFilter)] - -data ViewFilter - = FilterValues (S.Set MetaValue) - | FilterGlob Glob - -instance Show ViewFilter where - show (FilterValues s) = show s - show (FilterGlob g) = getGlob g - -instance Eq ViewFilter where - FilterValues x == FilterValues y = x == y - FilterGlob x == FilterGlob y = x == y - _ == _ = False - -instance Arbitrary ViewFilter where - arbitrary = do - size <- arbitrarySizedBoundedIntegral `suchThat` (< 100) - FilterValues . S.fromList <$> vector size - -#ifdef WITH_TDFA -data Glob = Glob String Regex -#else -data Glob = Glob String -#endif - -instance Eq Glob where - a == b = getGlob a == getGlob b - -getGlob :: Glob -> String -#ifdef WITH_TDFA -getGlob (Glob g _) = g -#else -getGlob (Glob g) = g -#endif - matchGlob :: Glob -> String -> Bool #ifdef WITH_TDFA matchGlob (Glob _ r) s = case execute r s of @@ -84,10 +46,10 @@ data ViewChange = Unchanged | Narrowing | Widening -} refineView :: View -> MetaField -> String -> (View, ViewChange) refineView view field wanted - | field `elem` (map fst view) = + | field `elem` (map viewField view) = let (view', viewchanges) = runWriter $ mapM updatefield view in (view', maximum viewchanges) - | otherwise = ((field, viewfilter) : view, Narrowing) + | otherwise = (ViewComponent field viewfilter : view, Narrowing) where viewfilter | any (`elem` wanted) "*?" = @@ -99,12 +61,12 @@ refineView view field wanted FilterGlob (Glob wanted) #endif | otherwise = FilterValues $ S.singleton $ toMetaValue wanted - updatefield :: (MetaField, ViewFilter) -> Writer [ViewChange] (MetaField, ViewFilter) - updatefield v@(f, vf) - | f == field = do - let (newvf, viewchange) = combineViewFilter vf viewfilter + updatefield :: ViewComponent -> Writer [ViewChange] ViewComponent + updatefield v + | viewField v == field = do + let (newvf, viewchange) = combineViewFilter (viewFilter v) viewfilter tell [viewchange] - return (f, newvf) + return $ v { viewFilter = newvf } | otherwise = return v {- Combine old and new ViewFilters, yielding a results that matches @@ -127,7 +89,7 @@ combineViewFilter old@(FilterValues olds) (FilterValues news) | otherwise = (combined, Widening) where combined = FilterValues (S.union olds news) -combineViewFilter (FilterValues old) newglob@(FilterGlob _) = +combineViewFilter (FilterValues _) newglob@(FilterGlob _) = (newglob, Widening) combineViewFilter (FilterGlob oldglob) new@(FilterValues s) | all (matchGlob oldglob . fromMetaValue) (S.toList s) = (new, Narrowing) @@ -151,17 +113,14 @@ multiValue (FilterGlob _) = True - through 5+ levels of subdirectories to find anything? -} viewTooLarge :: View -> Bool -viewTooLarge view = length (filter (multiValue . snd) view) > 5 - -type FileView = FilePath -type MkFileView = FilePath -> FileView +viewTooLarge view = length (filter (multiValue . viewFilter) view) > 5 {- Checks if metadata matches a filter, and if so returns the value, - or values that match. -} -matchFilter :: MetaData -> MetaField -> ViewFilter -> Maybe [MetaValue] -matchFilter metadata metafield (FilterValues s) = nonEmptyList $ +matchFilter :: MetaData -> ViewComponent -> Maybe [MetaValue] +matchFilter metadata (ViewComponent metafield (FilterValues s)) = nonEmptyList $ S.intersection s (currentMetaDataValues metafield metadata) -matchFilter metadata metafield (FilterGlob glob) = nonEmptyList $ +matchFilter metadata (ViewComponent metafield (FilterGlob glob)) = nonEmptyList $ S.filter (matchGlob glob . fromMetaValue) (currentMetaDataValues metafield metadata) nonEmptyList :: S.Set a -> Maybe [a] @@ -211,11 +170,11 @@ fileViews view mkfileview file metadata map (map toViewPath) (visible matches) where matches :: [Maybe [MetaValue]] - matches = map (uncurry $ matchFilter metadata) view + matches = map (matchFilter metadata) view visible :: [Maybe [MetaValue]] -> [[MetaValue]] visible = map (fromJust . snd) . filter (multiValue . fst) . - zip (map snd view) + zip (map viewFilter view) toViewPath :: MetaValue -> FilePath toViewPath = concatMap escapeslash . fromMetaValue @@ -259,8 +218,8 @@ pathProduct (l:ls) = foldl combinel l ls fromView :: View -> FileView -> MetaData fromView view f = foldr (uncurry updateMetaData) newMetaData (zip fields values) where - visible = filter (multiValue . snd) view - fields = map fst visible + visible = filter (multiValue . viewFilter) view + fields = map viewField visible paths = splitDirectories $ dropFileName f values = map fromViewPath paths @@ -272,9 +231,9 @@ prop_view_roundtrips :: FilePath -> MetaData -> Bool prop_view_roundtrips f metadata = null f || viewTooLarge view || all hasfields (fileViews view fileViewFromReference f metadata) where - view = map (\(mf, mv) -> (mf, FilterValues $ S.filter (not . null . fromMetaValue) mv)) + view = map (\(mf, mv) -> ViewComponent mf (FilterValues $ S.filter (not . null . fromMetaValue) mv)) (fromMetaData metadata) - visiblefields = sort (map fst $ filter (multiValue . snd) view) + visiblefields = sort (map viewField $ filter (multiValue . viewFilter) view) hasfields fv = sort (map fst (fromMetaData (fromView view fv))) == visiblefields {- Generates a git branch name for a View. @@ -287,11 +246,11 @@ branchView view | null name = Git.Ref "refs/views" | otherwise = Git.Ref $ "refs/views/" ++ name where - name = intercalate "/" $ map branchbit view - branchbit b@(_metafield, viewfilter) - | multiValue viewfilter = branchbit' b - | otherwise = "(" ++ branchbit' b ++ ")" - branchbit' (metafield, viewfilter) + name = intercalate "/" $ map branchcomp view + branchcomp c + | multiValue (viewFilter c) = branchcomp' c + | otherwise = "(" ++ branchcomp' c ++ ")" + branchcomp' (ViewComponent metafield viewfilter) | metafield == tagMetaField = branchvals viewfilter | otherwise = concat [ forcelegal (fromMetaField metafield) diff --git a/Types/View.hs b/Types/View.hs new file mode 100644 index 000000000..2c30541fa --- /dev/null +++ b/Types/View.hs @@ -0,0 +1,71 @@ +{- types for metadata based branch views + - + - Copyright 2014 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE CPP #-} + +module Types.View where + +import Common.Annex +import Types.MetaData +import Utility.QuickCheck + +import qualified Data.Set as S + +#ifdef WITH_TDFA +import Text.Regex.TDFA +#else +#endif + +{- A view is a list of fields with filters on their allowed values. -} +type View = [ViewComponent] + +data ViewComponent = ViewComponent + { viewField :: MetaField + , viewFilter :: ViewFilter + } + deriving (Show, Eq) + +instance Arbitrary ViewComponent where + arbitrary = ViewComponent <$> arbitrary <*> arbitrary + +{- Only files with metadata matching the view are displayed. -} +type FileView = FilePath +type MkFileView = FilePath -> FileView + +data ViewFilter + = FilterValues (S.Set MetaValue) + | FilterGlob Glob + +instance Show ViewFilter where + show (FilterValues s) = show s + show (FilterGlob g) = getGlob g + +instance Eq ViewFilter where + FilterValues x == FilterValues y = x == y + FilterGlob x == FilterGlob y = x == y + _ == _ = False + +instance Arbitrary ViewFilter where + arbitrary = do + size <- arbitrarySizedBoundedIntegral `suchThat` (< 100) + FilterValues . S.fromList <$> vector size + +#ifdef WITH_TDFA +data Glob = Glob String Regex +#else +data Glob = Glob String +#endif + +instance Eq Glob where + a == b = getGlob a == getGlob b + +getGlob :: Glob -> String +#ifdef WITH_TDFA +getGlob (Glob g _) = g +#else +getGlob (Glob g) = g +#endif |