Merge pull request #143 from L0neGamer/minortweaks

Minor Tweaks for backend stuff

.gitignore

@@ -15,7 +15,7 @@ _site
 
 cachedState
 the-log-of-discord-haskell.txt
-examples/auth-token.secret
+examples/*.secret
 upload-haddock.sh
 dist*
 

discord-haskell.cabal

@@ -1,6 +1,5 @@
 cabal-version:       2.0
 name:                discord-haskell
--- library version is also noted at src/Discord/Rest/Prelude.hs
 version:             1.15.1
 description:         Functions and data types to write discord bots.
                      Official discord docs <https://discord.com/developers/docs/reference>.
@@ -25,33 +24,84 @@ source-repository head
   location:            https://github.com/discord-haskell/discord-haskell.git
 
 executable ping-pong
-  main-is:             examples/ping-pong.hs
+  main-is:             ping-pong.hs
   default-language:    Haskell2010
-  ghc-options:         -Wall
-                       -fno-warn-type-defaults -fno-warn-unused-record-wildcards
-                       -threaded
+  ghc-options:         -Wall -fno-warn-type-defaults -fno-warn-unused-record-wildcards -threaded
+  hs-source-dirs:      examples
+  other-modules:
+    ExampleUtils
   build-depends:       base
                      , text
                      , unliftio
                      , discord-haskell
 
--- executable interaction-commands
---   main-is:             examples/interaction-commands.hs
---   default-language:    Haskell2010
---   ghc-options:         -Wall
---                        -fno-warn-type-defaults -fno-warn-unused-record-wildcards
---                        -threaded
---   build-depends:       base
---                      , text
---                      , unliftio
---                      , discord-haskell
---                      , bytestring
+executable interaction-commands
+  main-is:             interaction-commands.hs
+  default-language:    Haskell2010
+  ghc-options:         -Wall -fno-warn-type-defaults -fno-warn-unused-record-wildcards -threaded
+  hs-source-dirs:      examples
+  other-modules:
+    ExampleUtils
+  build-depends:       base
+                     , text
+                     , unliftio
+                     , discord-haskell
+                     , bytestring
+
+executable cache
+  main-is:             cache.hs
+  default-language:    Haskell2010
+  ghc-options:         -Wall -fno-warn-type-defaults -fno-warn-unused-record-wildcards -threaded
+  hs-source-dirs:      examples
+  other-modules:
+    ExampleUtils
+  build-depends:       base
+                     , text
+                     , unliftio
+                     , discord-haskell
+
+executable gateway
+  main-is:             gateway.hs
+  default-language:    Haskell2010
+  ghc-options:         -Wall -fno-warn-type-defaults -fno-warn-unused-record-wildcards -threaded
+  hs-source-dirs:      examples
+  other-modules:
+    ExampleUtils
+  build-depends:       base
+                     , text
+                     , unliftio
+                     , discord-haskell
+
+executable rest-without-gateway
+  main-is:             rest-without-gateway.hs
+  default-language:    Haskell2010
+  ghc-options:         -Wall -fno-warn-type-defaults -fno-warn-unused-record-wildcards -threaded
+  hs-source-dirs:      examples
+  other-modules:
+    ExampleUtils
+  build-depends:       base
+                     , text
+                     , unliftio
+                     , discord-haskell
+
+executable state-counter
+  main-is:             state-counter.hs
+  default-language:    Haskell2010
+  ghc-options:         -Wall -fno-warn-type-defaults -fno-warn-unused-record-wildcards -threaded
+  hs-source-dirs:      examples
+  other-modules:
+    ExampleUtils
+  build-depends:       base
+                     , text
+                     , unliftio
+                     , discord-haskell
 
 library
-  ghc-options:         -Wall
-                       -fno-warn-type-defaults -fno-warn-unused-record-wildcards -Wunused-packages
+  ghc-options:         -Wall -fno-warn-type-defaults -fno-warn-unused-record-wildcards
   hs-source-dirs:      src
   default-language:    Haskell2010
+  other-modules:
+    Paths_discord_haskell
   exposed-modules:   
       Discord
     , Discord.Types
@@ -88,7 +138,9 @@ library
     , Discord.Internal.Types.Emoji
     , Discord.Internal.Types.ScheduledEvents
   build-depends:
-    base ==4.*,
+  -- https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/libraries/version-history
+  -- below also sets the GHC version effectively. set to == 8.10.*, == 9.0.*.
+    base == 4.14.* || == 4.15.*,
     aeson >= 1.5 && < 1.6 || >= 2.0 && < 2.2,
     async >=2.2 && <2.3,
     bytestring >=0.10 && <0.11,

examples/ExampleUtils.hs

@@ -0,0 +1,29 @@
+module ExampleUtils where
+
+import qualified Data.Text as T
+import qualified Data.Text.IO as TIO
+import Discord
+import qualified Discord.Requests as R
+import Discord.Types
+import Text.Read (readMaybe)
+
+getToken :: IO T.Text
+getToken = TIO.readFile "./examples/auth-token.secret"
+
+getGuildId :: IO GuildId
+getGuildId = do
+  gids <- readFile "./examples/guildid.secret"
+  case readMaybe gids of
+    Just g -> pure g
+    Nothing -> error "could not read guild id from `guildid.secret`"
+
+-- | Given the test server and an action operating on a channel id, get the
+-- first text channel of that server and use the action on that channel.
+actionWithChannelId :: GuildId -> (ChannelId -> DiscordHandler a) -> DiscordHandler a
+actionWithChannelId testserverid f = do
+  Right chans <- restCall $ R.GetGuildChannels testserverid
+  (f . channelId) (head (filter isTextChannel chans))
+  where
+    isTextChannel :: Channel -> Bool
+    isTextChannel ChannelText {} = True
+    isTextChannel _ = False

examples/cache.hs

@@ -1,17 +1,21 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-import qualified Data.Text.IO as TIO
 import UnliftIO (liftIO)
 
 import Discord
 
+import ExampleUtils (getToken)
+
+main :: IO ()
+main = cacheExample
+
 -- There's not much information in the Cache for now
 --   but this program will show you what its got
 
 -- | Print cached Gateway info
 cacheExample :: IO ()
 cacheExample = do
-  tok <- TIO.readFile "./examples/auth-token.secret"
+  tok <- getToken
 
   _ <- runDiscord $ def { discordToken = tok
                         , discordOnStart = do

examples/auth-token → examples/example-setup

@@ -3,3 +3,5 @@ https://discord.com/developers/applications/me
 
 This is the Bot token (NOT CLIENT SECRET) from developer portal under the settings tab
 
+create a file named guildid.secret and add the guild id (server id) of your test server there.
+your bot may need certain permissions to run specific examples, like the interaction-commands example.

examples/gateway.hs

@@ -9,10 +9,16 @@ import qualified Data.Text.IO as TIO
 import Discord
 import Discord.Types
 
+import ExampleUtils (getToken, getGuildId)
+
+main :: IO ()
+main = gatewayExample
+
 -- | Prints every event as it happens
 gatewayExample :: IO ()
 gatewayExample = do
-  tok <- TIO.readFile "./examples/auth-token.secret"
+  tok <- getToken
+  testserverid <- getGuildId
 
   outChan <- newChan :: IO (Chan String)
 
@@ -22,7 +28,7 @@ gatewayExample = do
   threadId <- forkIO $ forever $ readChan outChan >>= putStrLn
 
   err <- runDiscord $ def { discordToken = tok
-                          , discordOnStart = startHandler
+                          , discordOnStart = startHandler testserverid
                           , discordOnEvent = eventHandler outChan
                           , discordOnEnd = killThread threadId
                           }
@@ -34,16 +40,14 @@ eventHandler :: Chan String -> Event -> DiscordHandler ()
 eventHandler out event = liftIO $ writeChan out (show event <> "\n")
 
 
-startHandler :: DiscordHandler ()
-startHandler = do
+startHandler :: GuildId -> DiscordHandler ()
+startHandler testserverid = do
   let opts = RequestGuildMembersOpts
-        { requestGuildMembersOptsGuildId = 453207241294610442
+        { requestGuildMembersOptsGuildId = testserverid
         , requestGuildMembersOptsLimit = 100
         , requestGuildMembersOptsNamesStartingWith = ""
         }
 
   -- gateway commands are enumerated in the discord docs
   -- https://discord.com/developers/docs/topics/gateway#commands-and-events-gateway-commands
   sendCommand (RequestGuildMembers opts)
-
-