module Network.Google.Drive.File
(
File(..)
, FileId
, FileData(..)
, FileTitle
, MimeType
, newFile
, newFolder
, setParent
, setMimeType
, getFile
, createFile
, updateFile
, deleteFile
, downloadFile
, isFolder
, isDownloadable
, localPath
, folderMimeType
) where
import Network.Google.Api
import Network.Google.Drive.DateTime
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>), (<*>), pure)
#endif
import Control.Monad (mzero, void)
import Data.Aeson
import Data.HashMap.Strict (HashMap, empty)
import Data.Maybe (isJust)
import Data.Monoid ((<>))
import Data.Text (Text)
import Data.Time (UTCTime)
import Network.HTTP.Conduit (HttpException(..))
import Network.HTTP.Types (status404)
import qualified Data.Traversable as F
import qualified Data.Text as T
type FileId = Text
type FileTitle = Text
type MimeType = Text
data FileData = FileData
{ fileTitle :: !FileTitle
, fileModified :: !(Maybe UTCTime)
, fileParents :: ![FileId]
, fileTrashed :: !Bool
, fileSize :: !(Maybe Int)
, fileDownloadUrl :: !(Maybe Text)
, fileMimeType :: !MimeType
, fileExportLinks :: !(HashMap MimeType Text)
}
data File = File
{ fileId :: FileId
, fileData :: FileData
}
instance Eq File where
a == b = fileId a == fileId b
instance Show File where
show f = localPath f <> " (" <> T.unpack (fileId f) <> ")"
instance FromJSON FileData where
parseJSON (Object o) = FileData
<$> o .: "title"
<*> o .: "modifiedDate"
<*> (mapM (.: "id") =<< o .: "parents")
<*> ((.: "trashed") =<< o .: "labels")
<*> (fmap read <$> o .:? "fileSize")
<*> o .:? "downloadUrl"
<*> o .: "mimeType"
<*> o .:? "exportLinks" .!= empty
parseJSON _ = mzero
instance ToJSON FileData where
toJSON FileData{..} = object
[ "title" .= fileTitle
, "modifiedDate" .= (formatDateTime <$> fileModified)
, "parents" .= map (\p -> object ["id" .= p]) fileParents
, "labels" .= object ["trashed" .= fileTrashed]
, "mimeType" .= fileMimeType
]
instance FromJSON File where
parseJSON v@(Object o) = File
<$> o .: "id"
<*> parseJSON v
parseJSON _ = mzero
getFile :: FileId -> Api (Maybe File)
getFile fid = (Just <$> getJSON (fileUrl fid) [])
`catchError` handleNotFound
where
handleNotFound (HttpError (StatusCodeException s _ _))
| s == status404 = return Nothing
handleNotFound e = throwError e
createFile :: FileData -> Api File
createFile fd =
postJSON (baseUrl <> "/files") (params $ fileModified fd) fd
where
params (Just _) = [("setModifiedDate", Just "true")]
params Nothing = []
updateFile :: FileId -> FileData -> Api File
updateFile fid fd =
putJSON (fileUrl $ fid) (params $ fileModified fd) fd
where
params (Just _) = [("setModifiedDate", Just "true")]
params Nothing = []
deleteFile :: File -> Api ()
deleteFile f = void $ requestLbs (fileUrl $ fileId f) $ setMethod "DELETE"
downloadFile :: File -> DownloadSink a -> Api (Maybe a)
downloadFile f sink = F.forM (fileDownloadUrl $ fileData f) $ \url ->
getSource (T.unpack url) [] sink
newFile :: FileTitle -> Maybe UTCTime -> FileData
newFile title maybeModified = FileData
{ fileTitle = title
, fileModified = maybeModified
, fileParents = []
, fileTrashed = False
, fileSize = Nothing
, fileDownloadUrl = Nothing
, fileMimeType = ""
, fileExportLinks = empty
}
newFolder :: FileTitle -> Maybe UTCTime -> FileData
newFolder title = setMimeType folderMimeType . newFile title
setParent :: File -> FileData -> FileData
setParent p f = f { fileParents = [fileId p] }
setMimeType :: MimeType -> FileData -> FileData
setMimeType m f = f { fileMimeType = m }
localPath :: File -> FilePath
localPath = T.unpack . fileTitle . fileData
isFolder :: File -> Bool
isFolder = (== folderMimeType) . fileMimeType . fileData
isDownloadable :: File -> Bool
isDownloadable = isJust . fileDownloadUrl . fileData
baseUrl :: URL
baseUrl = "https://www.googleapis.com/drive/v2"
fileUrl :: FileId -> URL
fileUrl fid = baseUrl <> "/files/" <> T.unpack fid
folderMimeType :: MimeType
folderMimeType = "application/vnd.google-apps.folder"