{-# LANGUAGE PatternSynonyms #-}
module Types where

import Prelude hiding (Word)

import Data.List (find)


kPROTOCOL_VERSION :: Int
kPROTOCOL_VERSION = 3


newtype Word = Word_ String
  deriving (Show, Eq, Ord)

pattern Word :: String -> Word
pattern Word s <- Word_ s
  where Word = Word_ . assertIsWord "Word"

newtype Line = Line_ String
  deriving (Show, Eq, Ord)

pattern Line :: String -> Line
pattern Line s <- Line_ s
  where Line = Line_ . assertIsLine "Line"

newtype User = User { fromUser :: Word }
  deriving (Show, Eq, Ord)

newtype Room = Room { fromRoom :: Word }
  deriving (Show, Eq, Ord)

newtype Id = Id_ { fromId :: Int }
  deriving (Show, Eq, Ord)

pattern Id :: Int -> Id
pattern Id i <- Id_ i
  where Id = Id_ . assertPositive "Id"

data Response
    = ROk
    | RNumber Int
    | RError String
    | RName Word
    | RList [Word]
    | RPong
    | RHistory Int
    | RHistoryMessage Int Message
    | RMessage Message
  deriving (Show)

data Push
    = POnline Int User
    | PMessage Message
    | PInvite Room User
    | PJoin Room User
    | PLeave Room User
    | PPing
  deriving (Show)

data Message
    = Message { msgRoom :: Room
              , msgUser :: User
              , msgTimestamp :: Int
              , msgId :: Id
              , msgReplyId :: Maybe Id
              , msgLine :: Line }
  deriving (Show)

-- Firebase-related commands elided
data Cmd
    = CVersion Word
    | CRegister User Line
    | CLogin User Line
    | CChangePassword Line
    | CLogout
    | CListRooms
    | CListMembers Room
    | CCreateRoom
    | CLeaveRoom Room
    | CInvite Room User
    | CSend Room (Maybe Id) Line
    | CHistory Room Int
    | CHistoryBefore Room Int Id
    | CGetMessage Id
    | CPing
    | CIsOnline User
    | CUserActive Bool
  deriving (Show)

assertIsWord :: String -> String -> String
assertIsWord typ s | Nothing <- find (\c -> c == ' ' || c == '\n') s = s
                   | otherwise = error ("Value put in " ++ typ ++ " is not a word")

assertIsLine :: String -> String -> String
assertIsLine typ s | Nothing <- find (== '\n') s = s
                   | otherwise = error ("Value put in " ++ typ ++ " is not a line")

assertPositive :: String -> Int -> Int
assertPositive typ i | i >= 0 = i
                     | otherwise = error ("Value put in " ++ typ ++ " is not positive")