diff --git a/google-drive.cabal b/google-drive.cabal --- a/google-drive.cabal +++ b/google-drive.cabal @@ -1,5 +1,5 @@ Name: google-drive -Version: 0.3.1 +Version: 0.4.0 Author: Pat Brisbin Maintainer: Pat Brisbin License: MIT @@ -20,6 +20,7 @@ GHC-Options: -Wall Exposed-Modules: Network.Google.Api , Network.Google.Drive + , Network.Google.Drive.DateTime , Network.Google.Drive.File , Network.Google.Drive.Search , Network.Google.Drive.Upload @@ -37,7 +38,7 @@ , resourcet , text , time - , timerep + , unordered-containers Test-Suite spec Type: exitcode-stdio-1.0 diff --git a/src/Network/Google/Api.hs b/src/Network/Google/Api.hs --- a/src/Network/Google/Api.hs +++ b/src/Network/Google/Api.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE OverloadedStrings #-} -- | @@ -49,8 +50,11 @@ , sinkFile ) where +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>)) -import Control.Monad.Error +#endif + +import Control.Monad.Except import Control.Monad.Reader import Control.Monad.Trans.Resource import Data.Aeson (FromJSON(..), ToJSON(..), eitherDecode, encode) @@ -66,8 +70,6 @@ , RequestBody(..) , Response(..) , Manager - , conduitManagerSettings - , closeManager , http , httpLbs , newManager @@ -75,6 +77,7 @@ , requestBodySource , responseBody , setQueryString + , tlsManagerSettings ) import Network.HTTP.Types ( Header @@ -105,21 +108,18 @@ show (InvalidJSON msg) = "failure parsing JSON: " <> msg show (GenericError msg) = msg -instance Error ApiError where - strMsg = GenericError - instance E.Exception ApiError -- | A transformer stack for providing the access token and rescuing errors -type Api = ReaderT (String, Manager) (ErrorT ApiError IO) +type Api = ReaderT (String, Manager) (ExceptT ApiError IO) -- | Run an @Api@ computation with the given Access token runApi :: String -- ^ OAuth2 access token -> Api a -> IO (Either ApiError a) -runApi token f = - E.bracket (newManager conduitManagerSettings) closeManager $ \manager -> - runErrorT $ runReaderT f (token, manager) +runApi token f = do + manager <- newManager tlsManagerSettings + runExceptT $ runReaderT f (token, manager) -- | Like @runApi@ but discards the result and raises @ApiError@s as exceptions runApi_ :: String -> Api a -> IO () diff --git a/src/Network/Google/Drive/DateTime.hs b/src/Network/Google/Drive/DateTime.hs new file mode 100644 --- /dev/null +++ b/src/Network/Google/Drive/DateTime.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE CPP #-} +module Network.Google.Drive.DateTime + ( formatDateTime + ) where + +#if __GLASGOW_HASKELL__ < 710 +import Control.Applicative ((<$>)) +#endif + +import Data.Text (Text) +import Data.Time (UTCTime) +import Data.Time.Format (defaultTimeLocale, formatTime) + +import qualified Data.Text as T + +-- | Format @'UTCTime'@ values for the Drive API +-- +-- The docs claim it must be RFC 3339 formatted, but in practice the fractional +-- seconds, @%Q@, (which the RFC states is optional) are required. +-- +formatDateTime :: UTCTime -> Text +formatDateTime = T.pack . formatTime defaultTimeLocale "%FT%T%QZ" diff --git a/src/Network/Google/Drive/File.hs b/src/Network/Google/Drive/File.hs --- a/src/Network/Google/Drive/File.hs +++ b/src/Network/Google/Drive/File.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | @@ -16,6 +18,7 @@ , FileId , FileData(..) , FileTitle + , MimeType -- * Building @File@s , newFile @@ -38,10 +41,15 @@ ) where import Network.Google.Api +import Network.Google.Drive.DateTime -import Control.Applicative ((<$>), (<*>)) +#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) @@ -54,16 +62,18 @@ type FileId = Text type FileTitle = Text +type MimeType = Text -- | Metadata about Files on your Drive data FileData = FileData { fileTitle :: !FileTitle - , fileModified :: !UTCTime + , fileModified :: !(Maybe UTCTime) , fileParents :: ![FileId] , fileTrashed :: !Bool , fileSize :: !(Maybe Int) , fileDownloadUrl :: !(Maybe Text) - , fileMimeType :: !Text + , fileMimeType :: !MimeType + , fileExportLinks :: !(HashMap MimeType Text) } -- | An existing file @@ -87,13 +97,14 @@ <*> (fmap read <$> o .:? "fileSize") -- fileSize is a String! <*> o .:? "downloadUrl" <*> o .: "mimeType" + <*> o .:? "exportLinks" .!= empty parseJSON _ = mzero instance ToJSON FileData where toJSON FileData{..} = object [ "title" .= fileTitle - , "modifiedDate" .= fileModified + , "modifiedDate" .= (formatDateTime <$> fileModified) , "parents" .= map (\p -> object ["id" .= p]) fileParents , "labels" .= object ["trashed" .= fileTrashed] , "mimeType" .= fileMimeType @@ -123,12 +134,18 @@ -- | Create a @File@ from @FileData@ createFile :: FileData -> Api File createFile fd = - postJSON (baseUrl <> "/files") [("setModifiedDate", Just "true")] fd + postJSON (baseUrl <> "/files") (params $ fileModified fd) fd + where + params (Just _) = [("setModifiedDate", Just "true")] + params Nothing = [] -- | Update a @File@ updateFile :: FileId -> FileData -> Api File updateFile fid fd = - putJSON (fileUrl $ fid) [("setModifiedDate", Just "true")] fd + putJSON (fileUrl $ fid) (params $ fileModified fd) fd + where + params (Just _) = [("setModifiedDate", Just "true")] + params Nothing = [] -- | Delete a @File@ deleteFile :: File -> Api () @@ -142,24 +159,25 @@ downloadFile f sink = F.forM (fileDownloadUrl $ fileData f) $ \url -> getSource (T.unpack url) [] sink -newFile :: FileTitle -> UTCTime -> FileData -newFile title modified = FileData +newFile :: FileTitle -> Maybe UTCTime -> FileData +newFile title maybeModified = FileData { fileTitle = title - , fileModified = modified + , fileModified = maybeModified , fileParents = [] , fileTrashed = False , fileSize = Nothing , fileDownloadUrl = Nothing , fileMimeType = "" + , fileExportLinks = empty } -newFolder :: FileTitle -> UTCTime -> FileData +newFolder :: FileTitle -> Maybe UTCTime -> FileData newFolder title = setMimeType folderMimeType . newFile title setParent :: File -> FileData -> FileData setParent p f = f { fileParents = [fileId p] } -setMimeType :: Text -> FileData -> FileData +setMimeType :: MimeType -> FileData -> FileData setMimeType m f = f { fileMimeType = m } -- | What to name this file if downloaded @@ -183,5 +201,5 @@ fileUrl :: FileId -> URL fileUrl fid = baseUrl <> "/files/" <> T.unpack fid -folderMimeType :: Text +folderMimeType :: MimeType folderMimeType = "application/vnd.google-apps.folder" diff --git a/src/Network/Google/Drive/Search.hs b/src/Network/Google/Drive/Search.hs --- a/src/Network/Google/Drive/Search.hs +++ b/src/Network/Google/Drive/Search.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | -- @@ -19,6 +20,8 @@ , (?<=) , (?>) , (?>=) + , (?&&) + , (?||) , qIn , qHas , qContains @@ -28,17 +31,20 @@ ) where import Network.Google.Api +import Network.Google.Drive.DateTime import Network.Google.Drive.File +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative ((<$>), (<$>)) +#endif + import Control.Monad (mzero) import Data.Aeson import Data.Char (toLower) import Data.Monoid ((<>)) import Data.Text (Text) import Data.Text.Encoding (encodeUtf8) -import Data.Time (UTCTime, utc, utcToZonedTime) -import Data.Time.RFC3339 (showRFC3339) +import Data.Time (UTCTime) import qualified Data.Text as T @@ -73,7 +79,7 @@ escapeValue False = "false" instance QueryValue UTCTime where - escapeValue = T.pack . showRFC3339 . utcToZonedTime utc + escapeValue = formatDateTime newtype Items = Items [File] @@ -143,17 +149,32 @@ qContains :: QueryValue a => Field -> a -> Query qContains = qOp "contains" +infixr 3 ?&& + +-- | Return files that match both clauses +(?&&) :: Query -> Query -> Query +q ?&& p = "(" <> p <> ") and (" <> q <> ")" + infixr 3 `qAnd` -- | Return files that match both clauses qAnd :: Query -> Query -> Query -q `qAnd` p = "(" <> p <> ") and (" <> q <> ")" +qAnd = (?&&) +infixr 2 ?|| + +-- | Return files that match either clause +(?||) :: Query -> Query -> Query +q ?|| p = "(" <> p <> ") or (" <> q <> ")" + infixr 2 `qOr` -- | Return files that match either clause qOr :: Query -> Query -> Query -q `qOr` p = "(" <> p <> ") or (" <> q <> ")" +qOr = (?||) + +{-# DEPRECATED qAnd "Use ?&& instead" #-} +{-# DEPRECATED qOr "Use ?|| instead" #-} -- | Negates a search clause qNot :: Query -> Query