{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE TypeApplications #-} module SubredditSpec ( spec ) where import Data.Foldable ( traverse_ ) import Data.Generics.Labels () import Data.Time import Lens.Micro.GHC import Network.Reddit import Test.Hspec spec :: Spec spec = beforeAll (loadClient Nothing) . describe "Network.Reddit.Submission" $ sequence_ [ getInfo , getTop , nameSearch , userFlair , missingFlair , submissionFlair , widgets , emojis , wikipages , collections , revisions ] getInfo :: SpecWith Client getInfo = it "gets subreddit info" $ \c -> do haskellSub <- mkSubredditName "haskell" subreddit <- runReddit c $ getSubreddit haskellSub subreddit ^. #name `shouldBe` haskellSub subreddit ^. #subredditID `shouldBe` SubredditID "2qh36" subreddit ^. #over18 `shouldBe` False subreddit ^. #quarantine `shouldBe` False subreddit ^. #created `shouldBe` read @UTCTime "2008-01-25 06:37:23 +0000" getTop :: SpecWith Client getTop = it "gets the top all-time submission" $ \c -> do let opts = defaultItemOpts & #itemTime ?~ AllTime paginator = emptyPaginator & (#limit .~ 1) . (#opts .~ opts) haskellSub <- mkSubredditName "haskell" listing <- runReddit c $ getTopSubmissions haskellSub paginator case listing ^? #children . _head of Nothing -> expectationFailure "Failed to get top submission" Just top -> top ^. #submissionID `shouldBe` SubmissionID "6x7ms0" nameSearch :: SpecWith Client nameSearch = it "searches subreddits by name" $ \c -> do results <- runReddit c $ searchSubredditsByName Nothing Nothing "haskell" names <- traverse mkSubredditName [ "haskell", "haskellquestions" ] traverse_ (shouldContain (results ^.. each) . pure) names userFlair :: SpecWith Client userFlair = it "gets user flair templates" $ \c -> do flairTemplates <- runReddit c $ getUserFlairTemplates =<< mkSubredditName "linux" case flairTemplates ^? _head of Nothing -> expectationFailure "Failed to get flair templates" Just flair -> do flairText <- mkFlairText ":linux:" flair ^. #text `shouldBe` flairText flair ^. #textEditable `shouldBe` False flair ^. #textColor `shouldBe` Just Dark flair ^. #allowableContent `shouldBe` AllContent missingFlair :: SpecWith Client missingFlair = it "throws the correct exception if user flair is not allowed" $ \c -> do let action = getUserFlairTemplates =<< mkSubredditName "haskell" ex = \case ErrorWithStatus (StatusMessage 403 "Forbidden") -> True _ -> False runReddit c action `shouldThrow` ex submissionFlair :: SpecWith Client submissionFlair = it "gets new submission flair choices" $ \c -> do haskellSub <- mkSubredditName "haskell" choices <- runReddit c (getNewSubmissionFlairChoices haskellSub) case choices ^? _head of Nothing -> expectationFailure "Failed to get flair choices" Just flair -> do flairText <- mkFlairText "announcement" flair ^. #text `shouldBe` flairText flair ^. #textEditable `shouldBe` False flair ^. #cssClass `shouldBe` Nothing widgets :: SpecWith Client widgets = it "gets subreddit widgets" $ \c -> do ws <- runReddit c $ getSubredditWidgets =<< mkSubredditName "haskell" let idCard = ws ^. #idCard idcID = WidgetID "id-card-2qh36" idcName <- mkShortName "Community Details" idCard ^. #widgetID `shouldBe` Just idcID idCard ^. #shortName `shouldBe` idcName let mods = ws ^. #moderators modsID = WidgetID "moderators-2qh36" modNames = mods ^.. #mods . each . #name dons <- mkUsername "dons" mods ^. #widgetID `shouldBe` Just modsID modNames `shouldContain` [ dons ] emojis :: SpecWith Client emojis = it "gets subreddit emojis" $ \c -> do es <- runReddit c $ getSubredditEmojis =<< mkSubredditName "linux" emojiName <- mkEmojiName "nix" case es ^? each . filtered ((== emojiName) . (^. #name)) of Nothing -> expectationFailure "Failed to get subreddit emojis" Just emoji -> do emoji ^. #modFlairOnly `shouldBe` False emoji ^. #postFlairAllowed `shouldBe` True emoji ^. #userFlairAllowed `shouldBe` True emoji ^. #createdBy `shouldBe` Just (UserID "den0g") wikipages :: SpecWith Client wikipages = it "gets subreddit wiki pages" $ \c -> do pages <- runReddit c $ getWikiPages =<< mkSubredditName "linux" pages ^.. each `shouldContain` [ mkWikiPageName "index" ] revisions :: SpecWith Client revisions = it "gets wiki page revisions" $ \c -> do let pageName = mkWikiPageName "index" paginator = emptyPaginator & #limit .~ 1 linuxSub <- mkSubredditName "linux" revs <- runReddit c $ getWikiPageRevisions linuxSub pageName paginator case revs ^? #children . _head of Nothing -> expectationFailure "Failed to get wiki page revisions" Just rev -> do page <- runReddit c . getWikiPageRevision linuxSub pageName $ rev ^. #revisionID rev ^. #author `shouldBe` page ^. #revisionBy collections :: SpecWith Client collections = it "gets subreddit collections" $ \c -> do pages <- runReddit c $ getWikiPages =<< mkSubredditName "linux" pages ^.. each `shouldContain` [ mkWikiPageName "index" ]