nekos-best 0.1.0.0 → 0.2.0.0
raw patch · 5 files changed
+114/−35 lines, 5 filesdep +random
Dependencies added: random
Files
- README.md +33/−5
- nekos-best.cabal +5/−3
- src/NekosBest/API.hs +65/−25
- src/NekosBest/Category.hs +6/−2
- src/NekosBest/Error.hs +5/−0
README.md view
@@ -1,18 +1,46 @@ # nekos-best + + + -Haskell wrapper for nekos.best API +Haskell wrapper for [nekos.best](https://nekos.best) API -## Example +## Examples Get a neko image ```haskell -module Main (main) where - import NekosBest.API (getNbImage) import qualified NekosBest.Category as C main = do res <- getNbImage C.Neko print res -```+``` + +___ + +For random images you can use `randomNbImage` passing a `RandomGen` value + +```haskell +import NekosBest.API (randomNbImage) +import qualified NekosBest.Category as C + +main = do + gen <- getStdGen + (res, gen') <- randomNbImage gen + print res + +``` +___ + +Downloading an image + +```haskell +import NekosBest.API (getNbImage, downloadNbImage) +import qualified NekosBest.Category as C + +main = do + res <- getNbImage C.Neko + mapM_ (\x -> downloadNbImage x "filename") res +```
nekos-best.cabal view
@@ -1,9 +1,9 @@ cabal-version: 2.4 name: nekos-best -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Unofficial nekos.best API wrapper description: The Nekos.best API Wrapper in Haskell is a powerful and flexible tool designed to interact seamlessly with the Nekos.best API, - a popular service for fetching adorable and charming neko-themed images, gifs + a popular service for fetching adorable and charming neko-themed images and more homepage: https://github.com/xquantxz/nekos-best.hs bug-reports: https://github.com/xquantxz/nekos-best.hs/issues build-type: Custom @@ -21,14 +21,16 @@ source-repository this type: git location: https://github.com/xquantxz/nekos-best.hs - tag: v0.1.0.0 + tag: v0.2.0.0 library exposed-modules: NekosBest.API NekosBest.Category + NekosBest.Error other-extensions: OverloadedStrings build-depends: base ^>= 4.16.4.0, + random ^>= 1.2.1, containers ^>= 0.6.5.1, bytestring ^>= 0.11.4.0, http-client ^>= 0.7.13.1,
src/NekosBest/API.hs view
@@ -2,56 +2,96 @@ module NekosBest.API ( getNbImage, - getNbImages -) where + getNbImages, + randomNbImage, + randomNbImages, + downloadNbImage +) where import Network.HTTP.Client import Network.HTTP.Types.Status (statusCode, requestHeaderFieldsTooLarge431) import Network.HTTP.Client.TLS (tlsManagerSettings) -import Data.Aeson ( decode', FromJSON, withObject, (.:), parseJSON) -import Data.ByteString.Lazy as L ( ByteString ) +import Data.Aeson ( decode', FromJSON, withObject, (.:?), parseJSON) +import Data.ByteString.Lazy as L ( ByteString, writeFile ) import Data.Map ( Map, findWithDefault ) import Data.Maybe ( fromMaybe ) import Data.Char (toLower) +import System.Random (RandomGen, randomR) -import NekosBest.Category ( NbCategory ) +import NekosBest.Category ( NbCategory, allCategories ) +import NekosBest.Error (NbError(..)) data NbResult = NbResult { - artistHref :: String, - artistName :: String, - sourceUrl :: String, - url :: String + artistHref :: Maybe String, + artistName :: Maybe String, + sourceUrl :: Maybe String, + animeName :: Maybe String, + url :: Maybe String } deriving (Show) instance FromJSON NbResult where parseJSON = withObject "NbResult" $ \v -> NbResult - <$> v .: "artist_href" - <*> v .: "artist_name" - <*> v .: "source_url" - <*> v .: "url" + <$> v .:? "artist_href" + <*> v .:? "artist_name" + <*> v .:? "source_url" + <*> v .:? "anime_name" + <*> v .:? "url" -getNbImages :: (Show i, Integral i) => NbCategory -> i -> IO [NbResult] -getNbImages c i = do +makeHttpRequest :: String -> IO (Response L.ByteString) +makeHttpRequest url = do manager <- newManager tlsManagerSettings + request <- parseRequest url + httpLbs request manager + +getNbImages :: (Show i, Integral i) => NbCategory -> i -> IO (Either NbError [NbResult]) +getNbImages c i = do let endpoint = toLower <$> show c - request <- parseRequest $ "https://nekos.best/api/v2/" ++ endpoint ++ "?amount=" ++ show i - response <- httpLbs request manager + response <- makeHttpRequest $ "https://nekos.best/api/v2/" ++ endpoint ++ "?amount=" ++ show i let status = statusCode $ responseStatus response if status == 200 then do let json = responseBody response let result = getResultsFromJson json - - return result + + return $ Right result else do - return [] - -getNbImage :: NbCategory -> IO (Maybe NbResult) + return $ Left (NbError "Received invalid HTTP status code") + +getNbImage :: NbCategory -> IO (Either NbError NbResult) getNbImage c = do result <- getNbImages c 1 - return $ case result of [] -> Nothing - r:_ -> Just r - + return $ fmap (\(x:_) -> x) result getResultsFromJson :: L.ByteString -> [NbResult] getResultsFromJson json = fromMaybe [] results where json' = decode' json :: Maybe (Map String [NbResult]) results = findWithDefault [] "results" <$> json' + + +randomNbImage :: (RandomGen g) => g -> IO (Either NbError NbResult, g) +randomNbImage gen = do + let (c, gen') = randomCategory gen + res <- getNbImage c + return (res, gen') + where randomIndex = randomR (0, length allCategories) + randomCategory gen = let (c, gen') = randomIndex gen + in (allCategories !! c, gen') + +randomNbImages :: (RandomGen g, Integral i) => g -> i -> IO ([Either NbError NbResult], g) +randomNbImages gen 0 = return ([], gen) +randomNbImages gen n = do + (res, gen') <- randomNbImage gen + (xs, gen'') <- randomNbImages gen' (n-1) + return $ case res of Right x -> (Right x:xs, gen'') + Left e -> (Left e:xs, gen'') + +downloadNbImage :: NbResult -> FilePath -> IO (Maybe NbError) +downloadNbImage res path = case url res of + Just x -> do + response <- makeHttpRequest x + let status = statusCode $ responseStatus response + if status == 200 then do + let content = responseBody response + L.writeFile path content + return Nothing + else do + return $ Just $ NbError "Received invalid HTTP status code" + Nothing -> return $ Just $ NbError "No image url in result"
src/NekosBest/Category.hs view
@@ -1,5 +1,6 @@ module NekosBest.Category ( - NbCategory(..) + NbCategory(..), + allCategories ) where data NbCategory = @@ -42,4 +43,7 @@ Yeet | Nod | Nom | - Nope deriving (Show, Eq)+ Nope deriving (Show, Eq) + +allCategories :: [NbCategory] +allCategories = [Baka,Bite,Blush,Bored,Cry,Cuddle,Dance,Facepalm,Feed,Happy,Highfive,Hug,Kiss,Laugh,Neko,Pat,Poke,Pout,Shrug,Slap,Sleep,Smile,Smug,Stare,Think,Thumbsup,Tickle,Wave,Wink,Kitsune,Waifu,Handhold,Kick,Punch,Shoot,Husbando,Yeet,Nod,Nom,Nope]
+ src/NekosBest/Error.hs view
@@ -0,0 +1,5 @@+module NekosBest.Error ( + NbError(..) +) where + +newtype NbError = NbError String deriving (Show)