-
Notifications
You must be signed in to change notification settings - Fork 0
/
Lib.hs
121 lines (102 loc) · 3.74 KB
/
Lib.hs
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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
module Lib
( runApp
) where
import Data.Morpheus.Client
import GHC.Generics (Generic)
import Data.Text
import Data.Time
import Data.Functor
import Data.Time.Format.ISO8601
import Control.Monad.Fail
import Data.String (fromString, IsString)
import qualified Data.ByteString.Lazy as L
import Network.HTTP.Req
import Data.Text.Encoding
-- add `__typename` beneath `object(expression: $expression)` to have it work when running
defineByDocumentFile
"./minimal-github.graphql"
[gql|
query FetchRepoFile ($repoOwner: String!, $repoName: String!, $expression: String!) {
repository(name: $repoName, owner: $repoOwner) {
object(expression: $expression) {
... on Blob {
isTruncated
text
}
}
}
}
|]
-- data RepositoryObjectGitObject
-- = RepositoryObjectGitObject {__typename :: Text} |
-- RepositoryObjectBlob {__typename :: Text,
-- isTruncated :: Bool,
-- text :: (Maybe Text)}
-- deriving Generic
-- deriving Show
-- deriving Eq
runApp :: IO ()
runApp = do
result <- githubFetchRepoFile
print result
githubFetchRepoFile :: IO (Either String FetchRepoFile)
githubFetchRepoFile = do
let args = produceFetchRepoFileInput
-- create new personal token https://github.com/settings/tokens
-- it doesn't require any additional privelages (ie. ignore all the checkboxes)
authToken = "insert token here"
qryFetchRepoFile authToken args
qryFetchRepoFile :: Text -> FetchRepoFileArgs -> IO (Either String FetchRepoFile)
qryFetchRepoFile = fetch . executeGraphQL
produceFetchRepoFileInput :: FetchRepoFileArgs
produceFetchRepoFileInput =
FetchRepoFileArgs
{ repoOwner = "facebook",
repoName = "react",
expression = "af219cc6e6c514099a667ffab4e2d80c5c0c1bcc:.nvmrc"
}
executeGraphQL :: Text -> L.ByteString -> IO L.ByteString
executeGraphQL authToken payload = runReq defaultHttpConfig $ do
let headers = header "Content-Type" "application/json"
<> header "Authorization" ("token " <> encodeUtf8 authToken)
<> header "Accept" "application/vnd.github.antiope-preview+json"
<> header "User-Agent" "morpheus-repro"
responseBody
<$> req POST
(https "api.github.com" /: "graphql")
(ReqBodyLbs payload)
lbsResponse
headers
-- newtype GitObjectID = GitObjectID {
-- _gitObjectIDText :: Text
-- } deriving (Show, Generic)
-- instance GQLScalar GitObjectID where
-- parseValue (String x) = Right $ GitObjectID x
-- parseValue _ = Left "GitObjectId must be a String"
-- serialize (GitObjectID value) = String value
-- newtype GitTimestamp = GitTimestamp {
-- _gitTimestampTime :: UTCTime
-- } deriving (Show, Generic)
-- instance GQLScalar GitTimestamp where
-- parseValue (String x) = iso8601ParseM (unpack x) <&> GitTimestamp
-- parseValue _ = Left "GitTimestamp must be a String"
-- serialize (GitTimestamp value) = String (pack $ iso8601Show value)
newtype DateTime = DateTime {
_datetimeTime :: UTCTime
} deriving (Eq, Show, Generic)
instance GQLScalar DateTime where
parseValue (String x) = iso8601ParseM (unpack x) <&> DateTime
parseValue _ = Left "DateTime must be a String"
serialize (DateTime value) = String (pack $ iso8601Show value)
instance IsString str => MonadFail (Either str) where
fail :: String -> Either str a
fail = Left . fromString
{-# INLINE fail #-}