Flow.hs

module Flowdock.REST.Flow
  (
  -- | Fetch data types
    Flow(..)
  , FlowOrganization(..)
  , FlowAccessMode(..)
  , Flows(..)

  -- | Update data types
  , CreateFlow(..)
  , FlowUpdate(..)

  -- | Flow API calls
  , listFlows
  , listAllFlows
  , getFlow
  , getFlowById
  , createFlow
  , updateFlow
  ) where

import           Control.Monad
import           Data.Aeson
import           Data.Aeson.TH
import           Data.Aeson.Types
import           Data.Char                  (toLower)
import           Data.Text                  (Text, pack)
import           Data.Vector                (toList)
import           GHC.Generics
import           Network.Http.Client        (Method(..))

import           Flowdock.Internal
import           Flowdock.REST
import           Flowdock.REST.User

-- -----------------------------------------------------------------------------
-- Deserialized Data Types

-- | The organization associated with a flow.
data FlowOrganization = FlowOrganization
    { organizationId                :: !Int
    , organizationName              :: !Text
    , organizationParamaterizedName :: !Text
    , userLimit                     :: !Int
    , userCount                     :: !Int
    , organizationActive            :: !Bool
    , organizationUrl               :: !Text
    } deriving(Show, Eq)

instance FromJSON FlowOrganization where
    parseJSON (Object o) = do
      oid                 <- o .: "id"
      name                <- o .: "name"
      paramaterized_name  <- o .: "parameterized_name"
      user_limit          <- o .: "user_limit"
      user_count          <- o .: "user_count"
      active              <- o .: "active"
      url                 <- o .: "url"
      return $ FlowOrganization oid name paramaterized_name user_limit user_count active url
    parseJSON _ = mzero

-- $(deriveFromJSON defaultOptions{fieldLabelModifier = flowOrganizationFromJSON} ''FlowOrganization)

data FlowAccessMode
    = Invitation
    | Link
    | Organization
    deriving (Generic, Show, Eq)

instance FromJSON FlowAccessMode where
    -- parseJSON = genericParseJSON defaultOptions { constructorTagModifier = map toLower }
    parseJSON (String s)
      | s == "invitation"   = return Invitation
      | s == "link"         = return Link
      | s == "organization" = return Organization
    parseJSON _ = mzero

$(deriveToJSON defaultOptions{constructorTagModifier = Prelude.map toLower} ''FlowAccessMode)

data Flow = Flow
    { flowId                :: !Text              -- ^ The flow ID
    , flowName              :: !Text              -- ^ Human readable name of the flow
    , flowParameterizedName :: !Text              -- ^ flow name for URLs (I think)
    , flowOrganization      :: !FlowOrganization  -- ^ Organization information
    , flowUnreadMentions    :: !Int
    , flowOpen              :: !Bool
    , flowJoined            :: !Bool
    , flowUrl               :: !Text
    , flowWebUrl            :: !Text
    , flowJoinUrl           :: !(Maybe Text)
    , flowAccessMode        :: !FlowAccessMode
    , flowUsers             :: !(Maybe [User])
    } deriving(Show, Eq)

instance FromJSON Flow where
    parseJSON (Object o) = do
      fid                <- o .: "id"
      name               <- o .: "name"
      paramaterized_name <- o .: "parameterized_name"
      organization       <- o .: "organization"
      unread_mentions    <- o .: "unread_mentions"
      open               <- o .: "open"
      joined             <- o .: "joined"
      url                <- o .: "url"
      web_url            <- o .: "web_url"
      join_url           <- o .:? "join_url"
      access_mode        <- o .: "access_mode"
      users              <- o .:? "users"
      return $ Flow fid name paramaterized_name organization unread_mentions open joined url web_url join_url access_mode users
    parseJSON _ = mzero

-- $(deriveFromJSON defaultOptions{fieldLabelModifier = camelToUnderscoreDrop 4} ''Flow)

newtype Flows = Flows { flows :: [Flow] } deriving(Show, Eq)

instance FromJSON Flows where
    parseJSON (Array as) = do
      flows <- mapM parseJSON $ toList as :: Parser [Flow]
      return $ Flows flows
    parseJSON _          = mzero

-- -----------------------------------------------------------------------------
-- Serialized Data Types

data CreateFlow = CreateFlow !Text deriving (Show, Eq)

instance ToJSON CreateFlow where
    toJSON (CreateFlow name) = object [ "name" .= name ]

data FlowUpdate = FlowUpdate
    { flowUpdateName       :: !Text
    , flowUpdateOpen       :: !Bool
    , flowUpdateDisabled   :: !Bool
    , flowUpdateAccessMode :: !FlowAccessMode
    } deriving (Show, Eq)

$(deriveToJSON defaultOptions{fieldLabelModifier = underscoreCase . drop 10} ''FlowUpdate)

-- -----------------------------------------------------------------------------
-- API Calls

includeUsers :: Bool -> Text
includeUsers True  = "1"
includeUsers False = "0"

listFlows :: Bool  -- ^ Whether to list the included users
          -> RestAPI (Either Error Flows)
listFlows user =
    request GET ["flows"] [("users", includeUsers user)] Nothing

listAllFlows :: Bool -- ^ Whether to list the included users
             -> RestAPI (Either Error Flows)
listAllFlows user =
    request GET ["flows", "all"] [("users", includeUsers user)] Nothing

getFlow :: Text -- ^ The paramaterized name of the organization
        -> Text -- ^ The parameterized name of the flow
        -> RestAPI (Either Error Flow)
getFlow organization flow =
    request GET ["flows", organization, flow] [] Nothing

getFlowById :: Int -- ^ The ID of the flow
            -> RestAPI (Either Error Flow)
getFlowById fid =
    request GET ["flows", "find"] [("id", pack $ show fid)] Nothing

createFlow :: Text       -- ^ The paramaterized name of the organization
           -> CreateFlow -- ^ The name to create
           -> RestAPI (Either Error Flow)
createFlow organization cf =
    request POST ["flows", organization] [] (Just $ encode cf)

updateFlow :: Text      -- ^ The paramaterized name of the organization
           -> Text      -- ^ The paramaterized name of the flow
           -> FlowUpdate -- ^ The command to update the flow
           -> RestAPI (Either Error Flow)
updateFlow organization flow fu =
    request PUT ["flows", organization, flow] [] (Just $ encode fu)