module MSGraphAPI.Drive where

import Data.Int (Int64)
import GHC.Generics (Generic(..))

-- aeson
import qualified Data.Aeson as A (ToJSON(..), FromJSON(..), genericParseJSON)
-- hoauth
import Network.OAuth.OAuth2.Internal (AccessToken(..))
-- req
import Network.HTTP.Req (Req)
-- text
import Data.Text (Text, pack, unpack)

import qualified MSGraphAPI.Internal.Common as MSG (get, post, Collection, aesonOptions)

-- | Get drive of current user
getDriveMe :: AccessToken -> Req Drive
getDriveMe :: AccessToken -> Req Drive
getDriveMe = forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"me", Text
"drive"] forall a. Monoid a => a
mempty

-- | List children in the root of the current user's drive
--
-- https://learn.microsoft.com/en-us/graph/api/driveitem-list-children?view=graph-rest-1.0&tabs=http#list-children-in-the-root-of-the-current-users-drive
getDriveItemsMe :: AccessToken -> Req (MSG.Collection DriveItem)
getDriveItemsMe :: AccessToken -> Req (Collection DriveItem)
getDriveItemsMe = forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"me", Text
"drive", Text
"root", Text
"children"] forall a. Monoid a => a
mempty

-- | List children in the root of the current user's drive
--
-- @GET \/drives\/{drive-id}\/items\/{item-id}\/children@
--
-- https://learn.microsoft.com/en-us/graph/api/driveitem-list-children?view=graph-rest-1.0&tabs=http#list-children-in-the-root-of-the-current-users-drive
getDriveItemChildren :: Text -- ^ drive ID
                     -> Text -- ^ item ID
                     -> AccessToken
                     -> Req (MSG.Collection DriveItem)
getDriveItemChildren :: Text -> Text -> AccessToken -> Req (Collection DriveItem)
getDriveItemChildren Text
did Text
itemId = forall a.
FromJSON a =>
[Text] -> Option 'Https -> AccessToken -> Req a
MSG.get [Text
"drives", Text
did, Text
"items", Text
itemId, Text
"children"] forall a. Monoid a => a
mempty

data Drive = Drive {
  Drive -> Text
dId :: Text
                   } deriving (Drive -> Drive -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Drive -> Drive -> Bool
$c/= :: Drive -> Drive -> Bool
== :: Drive -> Drive -> Bool
$c== :: Drive -> Drive -> Bool
Eq, Int -> Drive -> ShowS
[Drive] -> ShowS
Drive -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Drive] -> ShowS
$cshowList :: [Drive] -> ShowS
show :: Drive -> String
$cshow :: Drive -> String
showsPrec :: Int -> Drive -> ShowS
$cshowsPrec :: Int -> Drive -> ShowS
Show, forall x. Rep Drive x -> Drive
forall x. Drive -> Rep Drive x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Drive x -> Drive
$cfrom :: forall x. Drive -> Rep Drive x
Generic)

instance A.FromJSON Drive where
  parseJSON :: Value -> Parser Drive
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSG.aesonOptions String
"d")


data DriveItem = DriveItem {
  DriveItem -> Text
diName :: Text
  , DriveItem -> Maybe Int64
diSize :: Maybe Int64
                           } deriving (DriveItem -> DriveItem -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DriveItem -> DriveItem -> Bool
$c/= :: DriveItem -> DriveItem -> Bool
== :: DriveItem -> DriveItem -> Bool
$c== :: DriveItem -> DriveItem -> Bool
Eq, Int -> DriveItem -> ShowS
[DriveItem] -> ShowS
DriveItem -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DriveItem] -> ShowS
$cshowList :: [DriveItem] -> ShowS
show :: DriveItem -> String
$cshow :: DriveItem -> String
showsPrec :: Int -> DriveItem -> ShowS
$cshowsPrec :: Int -> DriveItem -> ShowS
Show, forall x. Rep DriveItem x -> DriveItem
forall x. DriveItem -> Rep DriveItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DriveItem x -> DriveItem
$cfrom :: forall x. DriveItem -> Rep DriveItem x
Generic)

instance A.FromJSON DriveItem where
  parseJSON :: Value -> Parser DriveItem
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
A.genericParseJSON (String -> Options
MSG.aesonOptions String
"di")