{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module NationStates.Region (
Region(..),
run,
name,
factbook,
numnations,
nations,
delegate,
delegatevotes,
gavote,
scvote,
founder,
power,
flag,
embassies,
tags,
) where
import Control.Applicative
import Control.Monad
import Text.XML.Light
import Prelude
import NationStates.Core
newtype Region a = Region { unRegion :: NS a }
deriving (Functor, Applicative)
run
:: String
-> Region a
-> Context
-> IO a
run region = requestNS (Just ("region", region)) . unRegion
name :: Region String
name = Region $ makeNS "name" "NAME"
factbook :: Region String
factbook = Region $ makeNS "factbook" "FACTBOOK"
numnations :: Region Integer
numnations = Region . fmap (expect "nation count" <*> readMaybe) $
makeNS "numnations" "NUMNATIONS"
nations :: Region [String]
nations = Region . fmap (wordsBy (== ':')) $ makeNS "nations" "NATIONS"
delegate :: Region (Maybe String)
delegate = Region . fmap (pureIf (/= "0")) $ makeNS "delegate" "DELEGATE"
delegatevotes :: Region Integer
delegatevotes = Region . fmap (expect "delegate vote count" <*> readMaybe) $
makeNS "delegatevotes" "DELEGATEVOTES"
gavote :: Region (Maybe (Integer, Integer))
gavote = Region $ makeNS' (shard "gavote") parse
where
parse _ = expect "GA vote counts" <$> showElement <*>
(grabVotes <=< findChild (unqual "GAVOTE"))
scvote :: Region (Maybe (Integer, Integer))
scvote = Region $ makeNS' (shard "scvote") parse
where
parse _ = expect "SC vote counts" <$> showElement <*>
(grabVotes <=< findChild (unqual "SCVOTE"))
grabVotes :: Element -> Maybe (Maybe (Integer, Integer))
grabVotes root = do
forStr <- grab "FOR"
againstStr <- grab "AGAINST"
return $ (,) <$> readMaybe forStr <*> readMaybe againstStr
where
grab childName = strContent <$> findChild (unqual childName) root
founder :: Region (Maybe String)
founder = Region . fmap (pureIf (/= "0")) $ makeNS "founder" "FOUNDER"
power :: Region String
power = Region $ makeNS "power" "POWER"
flag :: Region (Maybe String)
flag = Region . fmap (pureIf (/= "")) $ makeNS "flag" "FLAG"
embassies :: Region [String]
embassies = Region $ makeNS' (shard "embassies") parse
where
parse _ = expect "embassy names" <$> showElement <*>
fmap (grabChildren "EMBASSY") . findChild (unqual "EMBASSIES")
tags :: Region [String]
tags = Region $ makeNS' (shard "tags") parse
where
parse _ = expect "region tags" <$> showElement <*>
fmap (grabChildren "TAG") . findChild (unqual "TAGS")
grabChildren :: String -> Element -> [String]
grabChildren childName = map strContent . findChildren (unqual childName)