content: 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"
  