-- | B9 has a concept of 'B9.DiskImages.SharedImaged'. Shared images can be pulled and
-- pushed to/from remote locations via rsync+ssh. B9 also maintains a local cache;
-- the whole thing is supposed to be build-server-safe, that means no two builds
-- shall interfere with each other. This is accomplished by refraining from
-- automatic cache updates from/to remote repositories.
module B9.Repository
  ( RepoCacheReader,
    getRepoCache,
    withSelectedRemoteRepo,
    getSelectedRemoteRepo,
    SelectedRemoteRepoReader,
    Repository (..),
    RepoImagesMap,
    toRemoteRepository,
    SelectedRemoteRepo (..),
    remoteRepoCacheDir,
    localRepoDir,
    lookupRemoteRepo,
    filterRepoImagesMap,
    lookupCachedImages,
    allCachedSharedImages,
    allSharedImagesWithRepo,
    maxSharedImageOfAllRepos,
    allSharedImagesInRepo,
    allSharedImages,
    allRepositories,
    groupBySharedImageName,
    keepNLatestSharedImages,
    dropAllButNLatestSharedImages,
    module X,
  )
where

import B9.B9Config
import B9.B9Config.Repository as X
import B9.B9Error
import B9.DiskImages
import Control.Eff
import Control.Eff.Reader.Lazy
import Data.Foldable
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Generics
import System.FilePath
import Test.QuickCheck
import Text.Printf

data Repository
  = Cache
  | Remote String -- TODO use a newtype
  deriving (Repository -> Repository -> Bool
(Repository -> Repository -> Bool)
-> (Repository -> Repository -> Bool) -> Eq Repository
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repository -> Repository -> Bool
$c/= :: Repository -> Repository -> Bool
== :: Repository -> Repository -> Bool
$c== :: Repository -> Repository -> Bool
Eq, Eq Repository
Eq Repository
-> (Repository -> Repository -> Ordering)
-> (Repository -> Repository -> Bool)
-> (Repository -> Repository -> Bool)
-> (Repository -> Repository -> Bool)
-> (Repository -> Repository -> Bool)
-> (Repository -> Repository -> Repository)
-> (Repository -> Repository -> Repository)
-> Ord Repository
Repository -> Repository -> Bool
Repository -> Repository -> Ordering
Repository -> Repository -> Repository
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Repository -> Repository -> Repository
$cmin :: Repository -> Repository -> Repository
max :: Repository -> Repository -> Repository
$cmax :: Repository -> Repository -> Repository
>= :: Repository -> Repository -> Bool
$c>= :: Repository -> Repository -> Bool
> :: Repository -> Repository -> Bool
$c> :: Repository -> Repository -> Bool
<= :: Repository -> Repository -> Bool
$c<= :: Repository -> Repository -> Bool
< :: Repository -> Repository -> Bool
$c< :: Repository -> Repository -> Bool
compare :: Repository -> Repository -> Ordering
$ccompare :: Repository -> Repository -> Ordering
$cp1Ord :: Eq Repository
Ord, ReadPrec [Repository]
ReadPrec Repository
Int -> ReadS Repository
ReadS [Repository]
(Int -> ReadS Repository)
-> ReadS [Repository]
-> ReadPrec Repository
-> ReadPrec [Repository]
-> Read Repository
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Repository]
$creadListPrec :: ReadPrec [Repository]
readPrec :: ReadPrec Repository
$creadPrec :: ReadPrec Repository
readList :: ReadS [Repository]
$creadList :: ReadS [Repository]
readsPrec :: Int -> ReadS Repository
$creadsPrec :: Int -> ReadS Repository
Read, Int -> Repository -> ShowS
[Repository] -> ShowS
Repository -> String
(Int -> Repository -> ShowS)
-> (Repository -> String)
-> ([Repository] -> ShowS)
-> Show Repository
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Repository] -> ShowS
$cshowList :: [Repository] -> ShowS
show :: Repository -> String
$cshow :: Repository -> String
showsPrec :: Int -> Repository -> ShowS
$cshowsPrec :: Int -> Repository -> ShowS
Show, (forall x. Repository -> Rep Repository x)
-> (forall x. Rep Repository x -> Repository) -> Generic Repository
forall x. Rep Repository x -> Repository
forall x. Repository -> Rep Repository x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Repository x -> Repository
$cfrom :: forall x. Repository -> Rep Repository x
Generic)

instance Arbitrary Repository where
  arbitrary :: Gen Repository
arbitrary =
    [Gen Repository] -> Gen Repository
forall a. [Gen a] -> Gen a
Test.QuickCheck.oneof
      [ Repository -> Gen Repository
forall (f :: * -> *) a. Applicative f => a -> f a
pure Repository
Cache,
        String -> Repository
Remote (String -> Repository) -> (Int -> String) -> Int -> Repository
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"remote-repo-%0X" (Int -> Repository) -> Gen Int -> Gen Repository
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
31 :: Int)
      ]

instance Function Repository

instance CoArbitrary Repository

-- | Convert a `RemoteRepo` down to a mere `Repository`
toRemoteRepository :: RemoteRepo -> Repository
toRemoteRepository :: RemoteRepo -> Repository
toRemoteRepository = String -> Repository
Remote (String -> Repository)
-> (RemoteRepo -> String) -> RemoteRepo -> Repository
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteRepo -> String
remoteRepoRepoId

-- | Alias for a 'Reader' 'Eff'ect that reads a list of 'RemoteRepo's.
--
-- @since 0.5.65
type RepoCacheReader = Reader RepoCache

-- | Ask for the 'RepoCache' initialized by 'withRemoteRepos'.
--
-- @since 0.5.65
getRepoCache :: Member RepoCacheReader e => Eff e RepoCache
getRepoCache :: Eff e RepoCache
getRepoCache = Eff e RepoCache
forall e (r :: [* -> *]). Member (Reader e) r => Eff r e
ask

-- | Run a 'SelectedRemoteRepoReader' with the 'SelectedRemoteRepo' selected
-- in the 'B9Config'.
--
-- If the selected repo does not exist, and exception is thrown.
--
-- @since 0.5.65
withSelectedRemoteRepo ::
  (Member B9ConfigReader e, Member ExcB9 e) =>
  Eff (SelectedRemoteRepoReader ': e) a ->
  Eff e a
withSelectedRemoteRepo :: Eff (SelectedRemoteRepoReader : e) a -> Eff e a
withSelectedRemoteRepo Eff (SelectedRemoteRepoReader : e) a
e = do
  Set RemoteRepo
remoteRepos' <- B9Config -> Set RemoteRepo
_remoteRepos (B9Config -> Set RemoteRepo)
-> Eff e B9Config -> Eff e (Set RemoteRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff e B9Config
forall (e :: [* -> *]). Member B9ConfigReader e => Eff e B9Config
getB9Config
  Maybe String
mSelectedRepoName <- B9Config -> Maybe String
_repository (B9Config -> Maybe String)
-> Eff e B9Config -> Eff e (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Eff e B9Config
forall (e :: [* -> *]). Member B9ConfigReader e => Eff e B9Config
getB9Config
  case Maybe String
mSelectedRepoName of
    Maybe String
Nothing -> SelectedRemoteRepo
-> Eff (SelectedRemoteRepoReader : e) a -> Eff e a
forall e (r :: [* -> *]) w. e -> Eff (Reader e : r) w -> Eff r w
runReader (Maybe RemoteRepo -> SelectedRemoteRepo
MkSelectedRemoteRepo Maybe RemoteRepo
forall a. Maybe a
Nothing) Eff (SelectedRemoteRepoReader : e) a
e
    Just String
selectedRepoName ->
      case Set RemoteRepo -> String -> Maybe RemoteRepo
lookupRemoteRepo Set RemoteRepo
remoteRepos' String
selectedRepoName of
        Maybe RemoteRepo
Nothing ->
          String -> Eff e a
forall (e :: [* -> *]) a. Member ExcB9 e => String -> Eff e a
throwB9Error
            ( String -> String -> ShowS
forall r. PrintfType r => String -> r
printf
                String
"selected remote repo '%s' not configured, valid remote repos are: '%s'"
                (ShowS
forall a. Show a => a -> String
show String
selectedRepoName)
                (Set RemoteRepo -> String
forall a. Show a => a -> String
show Set RemoteRepo
remoteRepos')
            )
        Just RemoteRepo
r -> SelectedRemoteRepo
-> Eff (SelectedRemoteRepoReader : e) a -> Eff e a
forall e (r :: [* -> *]) w. e -> Eff (Reader e : r) w -> Eff r w
runReader (Maybe RemoteRepo -> SelectedRemoteRepo
MkSelectedRemoteRepo (RemoteRepo -> Maybe RemoteRepo
forall a. a -> Maybe a
Just RemoteRepo
r)) Eff (SelectedRemoteRepoReader : e) a
e

-- | Contains the 'Just' the 'RemoteRepo' selected by the 'B9Config' value '_repository',
-- or 'Nothing' of no 'RemoteRepo' was selected in the 'B9Config'.
--
-- @since 0.5.65
newtype SelectedRemoteRepo = MkSelectedRemoteRepo {SelectedRemoteRepo -> Maybe RemoteRepo
fromSelectedRemoteRepo :: Maybe RemoteRepo}

-- | Alias for a 'Reader' 'Eff'ect that reads the 'RemoteRepo'
-- selected by the 'B9Config' value '_repository'. See 'withSelectedRemoteRepo'.
--
-- @since 0.5.65
type SelectedRemoteRepoReader = Reader SelectedRemoteRepo

-- | Ask for the 'RemoteRepo'
-- selected by the 'B9Config' value '_repository'. See 'withSelectedRemoteRepo'.
--
-- @since 0.5.65
getSelectedRemoteRepo ::
  Member SelectedRemoteRepoReader e => Eff e SelectedRemoteRepo
getSelectedRemoteRepo :: Eff e SelectedRemoteRepo
getSelectedRemoteRepo = Eff e SelectedRemoteRepo
forall e (r :: [* -> *]). Member (Reader e) r => Eff r e
ask

-- | Return the cache directory for a remote repository relative to the root
-- cache dir.
remoteRepoCacheDir ::
  -- | The repository cache directory
  RepoCache ->
  -- | Id of the repository
  String ->
  -- | The existing, absolute path to the
  -- cache directory
  FilePath
remoteRepoCacheDir :: RepoCache -> ShowS
remoteRepoCacheDir (RepoCache String
cacheDir) String
repoId =
  String
cacheDir String -> ShowS
</> String
"remote-repos" String -> ShowS
</> String
repoId

-- | Return the local repository directory.
localRepoDir ::
  -- | The repository cache directory
  RepoCache ->
  -- | The existing, absolute path to the
  --  directory
  FilePath
localRepoDir :: RepoCache -> String
localRepoDir (RepoCache String
cacheDir) = String
cacheDir String -> ShowS
</> String
"local-repo"

-- | Select the first 'RemoteRepo' with a given @repoId@.
lookupRemoteRepo :: Set RemoteRepo -> String -> Maybe RemoteRepo
lookupRemoteRepo :: Set RemoteRepo -> String -> Maybe RemoteRepo
lookupRemoteRepo Set RemoteRepo
repos String
repoId = String -> Map String RemoteRepo -> Maybe RemoteRepo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
repoId Map String RemoteRepo
repoIdRepoPairs
  where
    repoIdRepoPairs :: Map String RemoteRepo
repoIdRepoPairs = 
      [(String, RemoteRepo)] -> Map String RemoteRepo
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((RemoteRepo -> (String, RemoteRepo))
-> [RemoteRepo] -> [(String, RemoteRepo)]
forall a b. (a -> b) -> [a] -> [b]
map (\r :: RemoteRepo
r@(RemoteRepo String
rid String
_ SshPrivKey
_ SshRemoteHost
_ SshRemoteUser
_) -> (String
rid, RemoteRepo
r)) (Set RemoteRepo -> [RemoteRepo]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Set RemoteRepo
repos))

-- | A 'Map' that maps 'Repository's to the 'SharedImage's they hold.
--
-- @since 1.1.0
type RepoImagesMap = Map Repository (Set SharedImage)

-- | Filter the 'SharedImage's returned by 'getSharedImages'
-- using a 'Repository'-, and a 'SharedImage' predicate.
--
-- @since 1.1.0
filterRepoImagesMap ::
  (Repository -> Bool) ->
  (SharedImage -> Bool) ->
  RepoImagesMap ->
  RepoImagesMap
filterRepoImagesMap :: (Repository -> Bool)
-> (SharedImage -> Bool) -> RepoImagesMap -> RepoImagesMap
filterRepoImagesMap Repository -> Bool
repoPred SharedImage -> Bool
imgPred =
  (Set SharedImage -> Set SharedImage)
-> RepoImagesMap -> RepoImagesMap
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((SharedImage -> Bool) -> Set SharedImage -> Set SharedImage
forall a. (a -> Bool) -> Set a -> Set a
Set.filter SharedImage -> Bool
imgPred)
    (RepoImagesMap -> RepoImagesMap)
-> (RepoImagesMap -> RepoImagesMap)
-> RepoImagesMap
-> RepoImagesMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Repository -> Set SharedImage -> Bool)
-> RepoImagesMap -> RepoImagesMap
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (Bool -> Set SharedImage -> Bool
forall a b. a -> b -> a
const (Bool -> Set SharedImage -> Bool)
-> (Repository -> Bool) -> Repository -> Set SharedImage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repository -> Bool
repoPred)

-- | Return the versions of a shared image named 'name' from the local cache.
--
-- @since 1.1.0
lookupCachedImages ::
  SharedImageName ->
  RepoImagesMap ->
  Set SharedImage
lookupCachedImages :: SharedImageName -> RepoImagesMap -> Set SharedImage
lookupCachedImages SharedImageName
name =
  RepoImagesMap -> Set SharedImage
allSharedImages
    (RepoImagesMap -> Set SharedImage)
-> (RepoImagesMap -> RepoImagesMap)
-> RepoImagesMap
-> Set SharedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Repository -> Bool)
-> (SharedImage -> Bool) -> RepoImagesMap -> RepoImagesMap
filterRepoImagesMap (Repository -> Repository -> Bool
forall a. Eq a => a -> a -> Bool
== Repository
Cache) ((SharedImageName -> SharedImageName -> Bool
forall a. Eq a => a -> a -> Bool
== SharedImageName
name) (SharedImageName -> Bool)
-> (SharedImage -> SharedImageName) -> SharedImage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SharedImage -> SharedImageName
sharedImageName)

-- | Return a 'Set' of 'Repository' names from a 'RepoImagesMap'
--
-- @since 1.1.0
allRepositories :: RepoImagesMap -> Set Repository
allRepositories :: RepoImagesMap -> Set Repository
allRepositories = RepoImagesMap -> Set Repository
forall k a. Map k a -> Set k
Map.keysSet

-- | Get a 'Set' of all 'SharedImage's in all 'Repository's.
--
-- @since 1.1.0
allSharedImages :: RepoImagesMap -> Set SharedImage
allSharedImages :: RepoImagesMap -> Set SharedImage
allSharedImages = RepoImagesMap -> Set SharedImage
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold

-- | Fetch all 'SharedImage's like 'allSharedImages' but attach
-- the 'Repository' that the image belongs to.
--
-- Usage example: In combination with 'filterRepoImagesMap' to find
-- the latest version of a certain image in all known repositories.
--
-- @since 1.1.0
allSharedImagesWithRepo :: RepoImagesMap -> Set (SharedImage, Repository)
allSharedImagesWithRepo :: RepoImagesMap -> Set (SharedImage, Repository)
allSharedImagesWithRepo = (Repository -> Set SharedImage -> Set (SharedImage, Repository))
-> RepoImagesMap -> Set (SharedImage, Repository)
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey ((SharedImage -> (SharedImage, Repository))
-> Set SharedImage -> Set (SharedImage, Repository)
forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map ((SharedImage -> (SharedImage, Repository))
 -> Set SharedImage -> Set (SharedImage, Repository))
-> (Repository -> SharedImage -> (SharedImage, Repository))
-> Repository
-> Set SharedImage
-> Set (SharedImage, Repository)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SharedImage -> Repository -> (SharedImage, Repository))
-> Repository -> SharedImage -> (SharedImage, Repository)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,))

-- | Return the maximum with regard to the 'Ord' instance of 'SharedImage'
-- from an 'RepoImagesMap'
--
-- @since 1.1.0
maxSharedImageOfAllRepos :: RepoImagesMap -> Maybe (SharedImage, Repository)
maxSharedImageOfAllRepos :: RepoImagesMap -> Maybe (SharedImage, Repository)
maxSharedImageOfAllRepos = Set (SharedImage, Repository) -> Maybe (SharedImage, Repository)
forall a. Set a -> Maybe a
Set.lookupMax (Set (SharedImage, Repository) -> Maybe (SharedImage, Repository))
-> (RepoImagesMap -> Set (SharedImage, Repository))
-> RepoImagesMap
-> Maybe (SharedImage, Repository)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoImagesMap -> Set (SharedImage, Repository)
allSharedImagesWithRepo

-- | Return the 'SharedImage's, that are contained in a 'Repository'.
--
-- @since 1.1.0
allSharedImagesInRepo :: Repository -> RepoImagesMap -> Set SharedImage
allSharedImagesInRepo :: Repository -> RepoImagesMap -> Set SharedImage
allSharedImagesInRepo Repository
repo = Set SharedImage -> Maybe (Set SharedImage) -> Set SharedImage
forall a. a -> Maybe a -> a
fromMaybe Set SharedImage
forall a. Set a
Set.empty (Maybe (Set SharedImage) -> Set SharedImage)
-> (RepoImagesMap -> Maybe (Set SharedImage))
-> RepoImagesMap
-> Set SharedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repository -> RepoImagesMap -> Maybe (Set SharedImage)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Repository
repo

-- | Keep 'SharedImage's that are in the 'Cache' 'Repository'.
--
-- @since 1.1.0
allCachedSharedImages ::
  RepoImagesMap ->
  Set SharedImage
allCachedSharedImages :: RepoImagesMap -> Set SharedImage
allCachedSharedImages = Repository -> RepoImagesMap -> Set SharedImage
allSharedImagesInRepo Repository
Cache

-- | Take a subset that contains the @n@
-- latest versions of 'SharedImage's with the same name.
--
-- For example, if the input contains:
--
-- @@@
-- fromList
-- [ SharedImage "foo" "2020-07-07 13:34:31"
-- , SharedImage "foo" "2020-07-07 13:34:32"
-- , SharedImage "foo" "2020-07-07 13:34:33"
-- , SharedImage "bar" "2020-07-07 13:34:34"
-- , SharedImage "bar" "2020-07-07 13:34:35"
-- , SharedImage "bar" "2020-07-07 13:34:36"
-- ]
-- @@@
--
-- The output of @keepNLatestSharedImages 2@ will be:
--
-- @@@
-- fromList
-- [ SharedImage "foo" "2020-07-07 13:34:32"
-- , SharedImage "foo" "2020-07-07 13:34:33"
-- , SharedImage "bar" "2020-07-07 13:34:35"
-- , SharedImage "bar" "2020-07-07 13:34:36"
-- ]
-- @@@
--
-- @since 1.1.0
keepNLatestSharedImages :: Int -> Set SharedImage -> Set SharedImage
keepNLatestSharedImages :: Int -> Set SharedImage -> Set SharedImage
keepNLatestSharedImages Int
n =
  Map SharedImageName (Set SharedImage) -> Set SharedImage
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    (Map SharedImageName (Set SharedImage) -> Set SharedImage)
-> (Set SharedImage -> Map SharedImageName (Set SharedImage))
-> Set SharedImage
-> Set SharedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set SharedImage -> Set SharedImage)
-> Map SharedImageName (Set SharedImage)
-> Map SharedImageName (Set SharedImage)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map
      ( \Set SharedImage
s ->
          let nOld :: Int
nOld = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Set SharedImage -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set SharedImage
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
           in Int -> Set SharedImage -> Set SharedImage
forall a. Int -> Set a -> Set a
Set.drop Int
nOld Set SharedImage
s
      )
    (Map SharedImageName (Set SharedImage)
 -> Map SharedImageName (Set SharedImage))
-> (Set SharedImage -> Map SharedImageName (Set SharedImage))
-> Set SharedImage
-> Map SharedImageName (Set SharedImage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set SharedImage -> Map SharedImageName (Set SharedImage)
groupBySharedImageName

-- | Take a subset that contains obsolete images.
--
-- Do the opposite of 'keepNLatestSharedImages',
-- and return all **but** the @n@
-- latest versions of 'SharedImage's with the same name.
--
-- For example, if the input contains:
--
-- @@@
-- fromList
-- [ SharedImage "foo" "2020-07-07 13:34:31"
-- , SharedImage "foo" "2020-07-07 13:34:32"
-- , SharedImage "foo" "2020-07-07 13:34:33"
-- , SharedImage "bar" "2020-07-07 13:34:34"
-- , SharedImage "bar" "2020-07-07 13:34:35"
-- , SharedImage "bar" "2020-07-07 13:34:36"
-- ]
-- @@@
--
-- The output of @keepNLatestSharedImages 2@ will be:
--
-- @@@
-- fromList
-- [ SharedImage "foo" "2020-07-07 13:34:31"
-- , SharedImage "bar" "2020-07-07 13:34:34"
-- ]
-- @@@
--
-- @since 1.1.0
dropAllButNLatestSharedImages :: Int -> Set SharedImage -> Set SharedImage
dropAllButNLatestSharedImages :: Int -> Set SharedImage -> Set SharedImage
dropAllButNLatestSharedImages Int
n =
  Map SharedImageName (Set SharedImage) -> Set SharedImage
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
    (Map SharedImageName (Set SharedImage) -> Set SharedImage)
-> (Set SharedImage -> Map SharedImageName (Set SharedImage))
-> Set SharedImage
-> Set SharedImage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set SharedImage -> Set SharedImage)
-> Map SharedImageName (Set SharedImage)
-> Map SharedImageName (Set SharedImage)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map
      ( \Set SharedImage
s ->
          let nOld :: Int
nOld = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Set SharedImage -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Set SharedImage
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n)
           in Int -> Set SharedImage -> Set SharedImage
forall a. Int -> Set a -> Set a
Set.take Int
nOld Set SharedImage
s
      )
    (Map SharedImageName (Set SharedImage)
 -> Map SharedImageName (Set SharedImage))
-> (Set SharedImage -> Map SharedImageName (Set SharedImage))
-> Set SharedImage
-> Map SharedImageName (Set SharedImage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set SharedImage -> Map SharedImageName (Set SharedImage)
groupBySharedImageName

-- | Group by 'SharedImageName'.
--
-- @since 1.1.0
groupBySharedImageName :: Set SharedImage -> Map SharedImageName (Set SharedImage)
groupBySharedImageName :: Set SharedImage -> Map SharedImageName (Set SharedImage)
groupBySharedImageName =
  (SharedImage
 -> Map SharedImageName (Set SharedImage)
 -> Map SharedImageName (Set SharedImage))
-> Map SharedImageName (Set SharedImage)
-> Set SharedImage
-> Map SharedImageName (Set SharedImage)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    ( \SharedImage
img ->
        (Maybe (Set SharedImage) -> Maybe (Set SharedImage))
-> SharedImageName
-> Map SharedImageName (Set SharedImage)
-> Map SharedImageName (Set SharedImage)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter
          ( Set SharedImage -> Maybe (Set SharedImage)
forall a. a -> Maybe a
Just
              (Set SharedImage -> Maybe (Set SharedImage))
-> (Maybe (Set SharedImage) -> Set SharedImage)
-> Maybe (Set SharedImage)
-> Maybe (Set SharedImage)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set SharedImage
-> (Set SharedImage -> Set SharedImage)
-> Maybe (Set SharedImage)
-> Set SharedImage
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                (SharedImage -> Set SharedImage
forall a. a -> Set a
Set.singleton SharedImage
img)
                (SharedImage -> Set SharedImage -> Set SharedImage
forall a. Ord a => a -> Set a -> Set a
Set.insert SharedImage
img)
          )
          (SharedImage -> SharedImageName
sharedImageName SharedImage
img)
    )
    Map SharedImageName (Set SharedImage)
forall k a. Map k a
Map.empty