{-# 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
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
(PageLinks -> PageLinks -> Bool)
-> (PageLinks -> PageLinks -> Bool) -> Eq PageLinks
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 -> String
(Int -> PageLinks -> ShowS)
-> (PageLinks -> String)
-> ([PageLinks] -> ShowS)
-> Show PageLinks
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PageLinks] -> ShowS
$cshowList :: [PageLinks] -> ShowS
show :: PageLinks -> String
$cshow :: PageLinks -> String
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 Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<> PageLinks -> Maybe Text
pageFirst PageLinks
links2)
(PageLinks -> Maybe Text
pagePrev PageLinks
links1 Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<> PageLinks -> Maybe Text
pagePrev PageLinks
links2)
(PageLinks -> Maybe Text
pageNext PageLinks
links1 Maybe Text -> Maybe Text -> Maybe Text
forall a. Semigroup a => a -> a -> a
<> PageLinks -> Maybe Text
pageNext PageLinks
links2)
(PageLinks -> Maybe Text
pageLast PageLinks
links1 Maybe Text -> Maybe Text -> Maybe Text
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 Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing
#if !MIN_VERSION_base(4,11,0)
mappend = (<>)
#endif
parsePageLinks :: Text -> PageLinks
parsePageLinks :: Text -> PageLinks
parsePageLinks = (PageLinks -> Text -> PageLinks)
-> PageLinks -> [Text] -> PageLinks
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl PageLinks -> Text -> PageLinks
resolve PageLinks
forall a. Monoid a => a
mempty ([Text] -> PageLinks) -> (Text -> [Text]) -> Text -> PageLinks
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 = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
url}
Text
"prev" -> PageLinks
pageLinks{pagePrev :: Maybe Text
pagePrev = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
url}
Text
"next" -> PageLinks
pageLinks{pageNext :: Maybe Text
pageNext = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
url}
Text
"last" -> PageLinks
pageLinks{pageLast :: Maybe Text
pageLast = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
url}
Text
_ -> String -> PageLinks
forall a. HasCallStack => String -> a
error (String -> PageLinks) -> String -> PageLinks
forall a b. (a -> b) -> a -> b
$ String
"Unknown rel in page link: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
link
parsePageLink :: Text -> (Text, Text)
parsePageLink :: Text -> (Text, Text)
parsePageLink Text
link = (Text, Text) -> Maybe (Text, Text) -> (Text, Text)
forall a. a -> Maybe a -> a
fromMaybe (String -> (Text, Text)
forall a. HasCallStack => String -> a
error (String -> (Text, Text)) -> String -> (Text, Text)
forall a b. (a -> b) -> a -> b
$ String
"Unknown page link: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
link) (Maybe (Text, Text) -> (Text, Text))
-> Maybe (Text, Text) -> (Text, Text)
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] -> (Text, Text) -> Maybe (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
url, Text
rel)
[Text]
_ -> Maybe (Text, Text)
forall a. Monoid a => a
mempty
Text
url <- Text -> Text -> Maybe Text
Text.stripPrefix Text
ghUrl (Text -> Maybe Text) -> Text -> Maybe Text
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'] -> Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text
dropAround Text
"\"" Text
"\"" Text
linkRel'
[Text]
_ -> Maybe Text
forall a. Monoid a => a
mempty
(Text, Text) -> Maybe (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
rel, Text
url)
where
ghUrl :: Text
ghUrl = Text
"https://api.github.com"
split :: Text -> Text -> [Text]
split :: Text -> Text -> [Text]
split Text
delim = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
Text.strip ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
Text.splitOn Text
delim
dropAround :: Text -> Text -> Text -> Text
dropAround :: Text -> Text -> Text -> Text
dropAround Text
begin Text
end Text
s = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. a
badDrop (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
Text.stripSuffix Text
end (Text -> Maybe Text) -> Maybe Text -> Maybe Text
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 = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Expected value to wrap within " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
begin String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"..." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
end String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
s