{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

module GitHub.REST.PageLinks (
  PageLinks (..),
  parsePageLinks,
) where

import Data.Maybe (fromMaybe)

#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.Text (Text)
import qualified Data.Text as Text

-- | Helper type for GitHub pagination.
--
--  https://developer.github.com/v3/guides/traversing-with-pagination/
data PageLinks = PageLinks
  { PageLinks -> Maybe Text
pageFirst :: Maybe Text
  , PageLinks -> Maybe Text
pagePrev :: Maybe Text
  , PageLinks -> Maybe Text
pageNext :: Maybe Text
  , PageLinks -> Maybe Text
pageLast :: Maybe Text
  }
  deriving (PageLinks -> PageLinks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PageLinks -> PageLinks -> Bool
$c/= :: PageLinks -> PageLinks -> Bool
== :: PageLinks -> PageLinks -> Bool
$c== :: PageLinks -> PageLinks -> Bool
Eq, Int -> PageLinks -> ShowS
[PageLinks] -> ShowS
PageLinks -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PageLinks] -> ShowS
$cshowList :: [PageLinks] -> ShowS
show :: PageLinks -> [Char]
$cshow :: PageLinks -> [Char]
showsPrec :: Int -> PageLinks -> ShowS
$cshowsPrec :: Int -> PageLinks -> ShowS
Show)

instance Semigroup PageLinks where
  PageLinks
links1 <> :: PageLinks -> PageLinks -> PageLinks
<> PageLinks
links2 =
    Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> PageLinks
PageLinks
      (PageLinks -> Maybe Text
pageFirst PageLinks
links1 forall a. Semigroup a => a -> a -> a
<> PageLinks -> Maybe Text
pageFirst PageLinks
links2)
      (PageLinks -> Maybe Text
pagePrev PageLinks
links1 forall a. Semigroup a => a -> a -> a
<> PageLinks -> Maybe Text
pagePrev PageLinks
links2)
      (PageLinks -> Maybe Text
pageNext PageLinks
links1 forall a. Semigroup a => a -> a -> a
<> PageLinks -> Maybe Text
pageNext PageLinks
links2)
      (PageLinks -> Maybe Text
pageLast PageLinks
links1 forall a. Semigroup a => a -> a -> a
<> PageLinks -> Maybe Text
pageLast PageLinks
links2)

instance Monoid PageLinks where
  mempty :: PageLinks
mempty = Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> PageLinks
PageLinks forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

#if !MIN_VERSION_base(4,11,0)
  mappend = (<>)
#endif

parsePageLinks :: Text -> PageLinks
parsePageLinks :: Text -> PageLinks
parsePageLinks = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl PageLinks -> Text -> PageLinks
resolve forall a. Monoid a => a
mempty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
split Text
","
  where
    resolve :: PageLinks -> Text -> PageLinks
    resolve :: PageLinks -> Text -> PageLinks
resolve PageLinks
pageLinks Text
"" = PageLinks
pageLinks
    resolve PageLinks
pageLinks Text
link =
      let (Text
rel, Text
url) = Text -> (Text, Text)
parsePageLink Text
link
       in case Text
rel of
            Text
"first" -> PageLinks
pageLinks{pageFirst :: Maybe Text
pageFirst = forall a. a -> Maybe a
Just Text
url}
            Text
"prev" -> PageLinks
pageLinks{pagePrev :: Maybe Text
pagePrev = forall a. a -> Maybe a
Just Text
url}
            Text
"next" -> PageLinks
pageLinks{pageNext :: Maybe Text
pageNext = forall a. a -> Maybe a
Just Text
url}
            Text
"last" -> PageLinks
pageLinks{pageLast :: Maybe Text
pageLast = forall a. a -> Maybe a
Just Text
url}
            Text
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown rel in page link: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
link

-- | Parse a single page link, like:
--
--  <https://api.github.com/search/code?q=addClass+user%3Amozilla&page=2>; rel="next"
--
--  Returns ("next", "/search/code?q=addClass+user%3Amozilla&page=2")
parsePageLink :: Text -> (Text, Text)
parsePageLink :: Text -> (Text, Text)
parsePageLink Text
link = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown page link: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Text
link) forall a b. (a -> b) -> a -> b
$ do
  (Text
linkUrl, Text
linkRel) <- case Text -> Text -> [Text]
split Text
";" Text
link of
    [Text
url, Text
rel] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
url, Text
rel)
    [Text]
_ -> forall a. Monoid a => a
mempty

  Text
url <- Text -> Text -> Maybe Text
Text.stripPrefix Text
ghUrl forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
dropAround Text
"<" Text
">" Text
linkUrl
  Text
rel <- case Text -> Text -> [Text]
split Text
"=" Text
linkRel of
    [Text
"rel", Text
linkRel'] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
dropAround Text
"\"" Text
"\"" Text
linkRel'
    [Text]
_ -> forall a. Monoid a => a
mempty

  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
rel, Text
url)
  where
    ghUrl :: Text
ghUrl = Text
"https://api.github.com"

{- Helpers -}

-- | Split the given text by the given delimiter, stripping any surrounding whitespace.
split :: Text -> Text -> [Text]
split :: Text -> Text -> [Text]
split Text
delim = forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
delim

-- | Drop the given strings at the beginning and end of the given text.
dropAround :: Text -> Text -> Text -> Text
dropAround :: Text -> Text -> Text -> Text
dropAround Text
begin Text
end Text
s = forall a. a -> Maybe a -> a
fromMaybe forall {a}. a
badDrop forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
Text.stripSuffix Text
end forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Maybe Text
Text.stripPrefix Text
begin Text
s
  where
    badDrop :: a
badDrop = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Expected value to wrap within " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Text.unpack Text
begin forall a. [a] -> [a] -> [a]
++ [Char]
"..." forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Text.unpack Text
end forall a. [a] -> [a] -> [a]
++ [Char]
": " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Text.unpack Text
s