User.hs

module Reddit.Types.User where

import Reddit.Parser
import Reddit.Types.Thing

import Control.Applicative
import Data.Aeson
import Data.Monoid
import Data.Text (Text)
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Network.API.Builder.Query
import Prelude
import qualified Data.Text as Text
import qualified Data.Vector as Vector

newtype Username = Username Text
  deriving (Show, Read, Ord)

instance Eq Username where
  Username x == Username y = Text.toCaseFold x == Text.toCaseFold y

instance FromJSON Username where
  parseJSON (String s) = return $ Username s
  parseJSON _ = mempty

instance ToQuery Username where
  toQuery k (Username user) = [(k, user)]

newtype UserID = UserID Text
  deriving (Show, Read, Eq, Ord)

instance FromJSON UserID where
  parseJSON (String s) =
    UserID <$> stripPrefix userPrefix s
  parseJSON _ = mempty

instance Thing UserID where
  fullName (UserID u) = mconcat [userPrefix, "_", u]

instance ToQuery UserID where
  toQuery k v = [(k, fullName v)]

data User =
  User { userID :: Text
       , userName :: Username
       , userCreated :: UTCTime
       , linkKarma :: Integer
       , commentKarma :: Integer
       , hasMail :: Maybe Bool
       , hasModMail :: Maybe Bool
       , isFriend :: Bool
       , userIsOver18 :: Maybe Bool
       , isMod :: Bool
       , hasGold :: Bool
       , hasVerifiedEmail :: Maybe Bool }
  deriving (Show, Eq)

instance FromJSON User where
  parseJSON (Object o) = do
    o `ensureKind` userPrefix
    d <- o .: "data"
    User <$> d .: "id"
         <*> d .: "name"
         <*> (posixSecondsToUTCTime . fromInteger <$> d .: "created_utc")
         <*> d .: "link_karma"
         <*> d .: "comment_karma"
         <*> d .:? "has_mail"
         <*> d .:? "has_mod_mail"
         <*> d .: "is_friend"
         <*> d .:? "over_18"
         <*> d .: "is_mod"
         <*> d .: "is_gold"
         <*> d .:? "has_verified_email"
  parseJSON _ = mempty

newtype UserList = UserList [Relationship]
  deriving (Show, Read, Eq)

instance FromJSON UserList where
  parseJSON (Object o) = do
    o `ensureKind` "UserList"
    UserList <$> ((o .: "data") >>= (.: "children"))
  parseJSON (Array a) =
    case Vector.toList a of
      [o] -> parseJSON o
      [o, _] -> parseJSON o
      _ -> mempty
  parseJSON _ = fail "wat"

data Relationship =
  Relationship { relationUsername :: Username
               , relationUserID :: UserID
               , relationSince :: UTCTime
               , relationNote :: Maybe Text }
  deriving (Show, Read, Eq)

instance FromJSON Relationship where
  parseJSON (Object o) =
    Relationship <$> o .: "name"
                 <*> o .: "id"
                 <*> (posixSecondsToUTCTime . fromInteger <$> o .: "date")
                 <*> (f <$> o .:? "note")
    where f (Just "") = Nothing
          f x = x
  parseJSON _ = fail "Relationship should be an object"

userPrefix :: Text
userPrefix = "t2"