diff --git a/haskmon.cabal b/haskmon.cabal --- a/haskmon.cabal +++ b/haskmon.cabal @@ -1,5 +1,5 @@ name: haskmon -version: 0.1.0.0 +version: 0.1.1.0 synopsis: A haskell wrapper for PokeAPI.co (www.pokeapi.co) description: This is a haskell wrapper for the RESTful api www.pokeapi.co. It defines most of the types and functions to get them. license: MIT diff --git a/src/Haskmon.hs b/src/Haskmon.hs --- a/src/Haskmon.hs +++ b/src/Haskmon.hs @@ -1,8 +1,8 @@ -- | Examples: -- -- >>> import Haskmon --- >>> getPokemonByName "eevee" :: IO (Maybe Pokemon) --- Just (Pokemon {pokemonName = "Eevee", pokemonNationalId = 133, ... }) +-- >>> getPokemonByName "eevee" :: IO Pokemon +-- Pokemon {pokemonName = "Eevee", pokemonNationalId = 133, ... } -- >>> getMoveById 1 :: IO Move -- Move {moveName = "Pound", movePower = 40, movePp = 35, moveAccuracy = 100, moveMetadata = MetaData {resourceUri = "/api/v1/move/1/", created = 2013-11-03 15:06:09.478009 UTC, modified = 2013-12-24 15:24:29.625596 UTC}} -- diff --git a/src/Haskmon/Client.hs b/src/Haskmon/Client.hs --- a/src/Haskmon/Client.hs +++ b/src/Haskmon/Client.hs @@ -24,58 +24,53 @@ type ID = Word -- | Utility wrapper for `ById` functions -getResourceById :: FromJSON a => String -> ID -> IO a -getResourceById res dbId = getResource $ "api/v1/" ++ res ++ "/" ++ show dbId ++ "/" +getResourceById :: FromJSON a => String -> String -> IO a +getResourceById res dbId = getResource $ "api/v1/" ++ res ++ "/" ++ dbId ++ "/" ---------------------------------------------------------------------------- -- | Get a pokedex. Warning: returns a large list of pokemon resources getPokedexById :: ID -> IO Pokedex -getPokedexById = getResourceById "pokedex" +getPokedexById = getResourceById "pokedex" . show getNationalPokedex :: IO Pokedex getNationalPokedex = getPokedexById 1 -- At the moment, this is the only pokedex -- | Get a pokemon by ID getPokemonById :: ID -> IO Pokemon -getPokemonById = getResourceById "pokemon" +getPokemonById = getResourceById "pokemon" . show -- | Lookup a pokemon by name in the national pokedex --- WARNING: Calls the pokedex api which returns a big list. It then does a lookup by name on said list. getPokemonByName :: String -- ^ Name of the pokemon - -> IO (Maybe Pokemon) -- ^ If no pokemon is found, return IO Nothing -getPokemonByName name = do - metaPkms <- pokedexPokemons <$> getNationalPokedex - let lName = toLower <$> name -- Lowercase it. All names in the pokedex meta are lower - maybePk = find ( (==) lName . mPokemonName) metaPkms - T.sequence $ fmap getPokemon maybePk + -> IO Pokemon +getPokemonByName = getResourceById "pokemon" -- | Get an ability by ID getAbilityById :: ID -> IO Ability -getAbilityById = getResourceById "ability" +getAbilityById = getResourceById "ability" . show -- | Get a move by ID getMoveById :: ID -> IO Move -getMoveById = getResourceById "move" +getMoveById = getResourceById "move" . show -- | Get a type by ID getTypeById :: ID -> IO Type -getTypeById = getResourceById "type" +getTypeById = getResourceById "type" . show -- -- | Get a egg group by ID getEggGroupById :: ID -> IO EggGroup -getEggGroupById = getResourceById "egg" +getEggGroupById = getResourceById "egg" . show -- | Get a description group by ID getDescriptionById :: ID -> IO Description -getDescriptionById = getResourceById "description" +getDescriptionById = getResourceById "description" . show -- | Get a game by ID getGameById :: ID -> IO Description -getGameById = getResourceById "game" +getGameById = getResourceById "game" . show -- | Get Sprite by ID getSpriteById :: ID -> IO Sprite -getSpriteById = getResourceById "sprite" +getSpriteById = getResourceById "sprite" . show diff --git a/src/Haskmon/Types.hs b/src/Haskmon/Types.hs --- a/src/Haskmon/Types.hs +++ b/src/Haskmon/Types.hs @@ -9,3 +9,4 @@ import Haskmon.Types.MetaData as X import Haskmon.Types.EggGroup as X import Haskmon.Types.Description as X +import Haskmon.Types.Evolutions as X diff --git a/src/Haskmon/Types/Internals.hs b/src/Haskmon/Types/Internals.hs --- a/src/Haskmon/Types/Internals.hs +++ b/src/Haskmon/Types/Internals.hs @@ -74,6 +74,7 @@ pokemonSpAtk :: Word, pokemonSpDef :: Word, pokemonSpeed :: Word, + pokemonEvolutions :: [Evolution], pokemonSprites :: [MetaSprite], pokemonDescriptions :: [MetaDescription], pokemonMetadata :: MetaData @@ -96,6 +97,7 @@ v .: "sp_atk" <*> v .: "sp_def" <*> v .: "speed" <*> + v .: "evolutions" <*> v .: "sprites" <*> v .: "descriptions" <*> getMetadata v @@ -103,16 +105,48 @@ --- }}} -- Evolution {{{ -{- At the moment, evolutions don't seem to be very consistent or complete (in the Rest API). - - Ignoring for now data Evolution = Evolution { evolutionName :: String, - evolutionMethod :: EvolutionMethod + evolutionMethod :: EvolutionMethod, evolutionPokemon :: IO Pokemon } -data EvolutionMethod = LevelUp { evolutionLevel :: Word } - | Friendship --} + +instance Show Evolution where + show e = "" + +data EvolutionMethod = EvolutionLevelUp LevelUpDetail + | EvolutionFriendship + | EvolutionStone + | EvolutionHappiness + | EvolutionTrade + | EvolutionOther -- Plain other...no info whatsoever + deriving Show + +data LevelUpDetail = Level Word + | LevelSpecial + deriving Show + +instance FromJSON EvolutionMethod where + parseJSON o = withO o $ \v -> + do method <- v .: "method" :: Parser String + case method of + "trade" -> return EvolutionTrade + "stone" -> return EvolutionStone + "level_up" -> EvolutionLevelUp <$> maybe LevelSpecial Level <$> v .:? "level" + "other" -> go $ v .:? "detail" + where go pt = do str <- pt + case str of + Nothing -> return EvolutionOther + Just "happiness" -> return EvolutionHappiness + Just "friendship" -> return EvolutionFriendship + Just l -> fail $ "Expected happiness or friendship, got " ++ l + +instance FromJSON Evolution where + parseJSON o = withO o $ \v -> Evolution <$> + v .: "to" <*> + parseJSON o <*> + (getResource <$> v .: "resource_uri") + -- }}} -- Ability {{{ data MetaAbility = MetaAbility { mAbilityName :: String, getAbility :: IO Ability} @@ -166,11 +200,11 @@ -- }}} -- Moves {{{ -data MetaMoveLearnType = LevelUp Int - | Machine - | Tutor - | EggMove - | Other deriving Show +data MetaMoveLearnType = MoveLearnLevelUp Word + | MoveLearnMachine + | MoveLearnTutor + | MoveLearnEggMove + | MoveLearnOther deriving Show data MetaMove = MetaMove { mMoveName :: String, mMoveLearnType :: MetaMoveLearnType, @@ -203,11 +237,11 @@ mmLearnType = do learnType <- o .: "learn_type" :: Parser String case learnType of - "level up" -> LevelUp <$> (o .: "level") - "machine" -> return Machine - "tutor" -> return Tutor - "egg move" -> return EggMove - "other" -> return Other + "level up" -> MoveLearnLevelUp <$> (o .: "level") + "machine" -> return MoveLearnMachine + "tutor" -> return MoveLearnTutor + "egg move" -> return MoveLearnEggMove + "other" -> return MoveLearnOther err -> fail $ "expected level_up, machine, tutor, egg_move or other. Got " ++ err -- }}} diff --git a/src/Haskmon/Types/Pokemon.hs b/src/Haskmon/Types/Pokemon.hs --- a/src/Haskmon/Types/Pokemon.hs +++ b/src/Haskmon/Types/Pokemon.hs @@ -13,7 +13,8 @@ MetaEggGroup, MetaDescription, Pokedex, - Pokemon) + Pokemon, + Evolution) import qualified Haskmon.Types.Internals as I -- Pokedex @@ -81,3 +82,7 @@ pokemonMetadata :: Pokemon -> MetaData pokemonMetadata = I.pokemonMetadata + +pokemonEvolutions :: Pokemon -> [Evolution] +pokemonEvolutions = I.pokemonEvolutions +