aboutsummaryrefslogtreecommitdiff
path: root/Types/StoreRetrieve.hs
blob: 2520d630920bcc79a583fec9d40127a39121929f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
{- Types for Storer and Retriever
 -
 - Copyright 2014 Joey Hess <joey@kitenet.net>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

{-# LANGUAGE Rank2Types #-}

module Types.StoreRetrieve where

import Common.Annex
import Utility.Metered
import Utility.Tmp

import qualified Data.ByteString.Lazy as L

-- Prepares for and then runs an action that will act on a Key's
-- content, passing it a helper when the preparation is successful.
type Preparer helper = forall a. Key -> (Maybe helper -> Annex a) -> Annex a

-- A source of a Key's content.
data ContentSource
	= FileContent FilePath
	| ByteContent L.ByteString

-- Action that stores a Key's content on a remote.
-- Can throw exceptions.
type Storer = Key -> ContentSource -> MeterUpdate -> IO Bool

-- Action that retrieves a Key's content from a remote.
-- Throws exception if key is not present, or remote is not accessible.
type Retriever = Key -> IO ContentSource

fileStorer :: (Key -> FilePath -> MeterUpdate -> IO Bool) -> Storer
fileStorer a k (FileContent f) m = a k f m
fileStorer a k (ByteContent b) m = do
	 withTmpFile "tmpXXXXXX" $ \f h -> do
		L.hPut h b
		hClose h
		a k f m

byteStorer :: (Key -> L.ByteString -> MeterUpdate -> IO Bool) -> Storer
byteStorer a k c m = withBytes c $ \b -> a k b m

withBytes :: ContentSource -> (L.ByteString -> IO a) -> IO a
withBytes (ByteContent b) a = a b
withBytes (FileContent f) a = a =<< L.readFile f

fileRetriever :: (Key -> IO FilePath) -> Retriever
fileRetriever a k = FileContent <$> a k

byteRetriever :: (Key -> IO L.ByteString) -> Retriever
byteRetriever a k = ByteContent <$> a k