summaryrefslogtreecommitdiff
path: root/example/Main.hs
blob: 9ce222da9735b184579275f6cd5c7da58a4284cd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
module Main where

import           Data.Fallible
import qualified Data.List     as L

main :: IO ()
main = test
  where
    test = run "Alice" "dummy" False

run :: String -> Token -> Bool -> IO ()
run targetName token verbose = evalContT $ do
  users    <- lift (getUsers token) !?= exit . logDebug'
  targetId <- userId <$> L.find isTarget users ??? exit (logDebug' emsg)
  channels <- lift (getChannels token) !?= exit . logDebug'
  lift $ mapM_ (logDebug' . channelName) $
    filter (elem targetId . channelMembers) channels
  where
    logDebug' = logDebug verbose
    emsg = "user not found: " ++ targetName
    isTarget user = userName user == targetName

logDebug :: Bool -> String -> IO ()
logDebug verbose msg = if verbose then putStrLn msg else pure ()

-- Dummy API

type UserId = String

data User = User
  { userId    :: UserId
  , userName  :: String
  , userEmail :: String
  , userAdmin :: Bool
  } deriving (Show, Eq)

data Channel = Channel
  { channelId      :: String
  , channelName    :: String
  , channelMembers :: [UserId]
  , channelPrivate :: Bool
  } deriving (Show, Eq)

type Error = String

type Token = String

getUsers :: Token -> IO (Either Error [User])
getUsers ""     = pure (Left "invalid token")
getUsers _token = pure (Right _users)

_users :: [User]
_users =
  [ User "u123456" "Alice" "alice@example.com" False
  , User "u123457" "Bob"   "bob@example.com"   False
  , User "u123458" "Curry" "curry@example.com" True
  ]

getChannels :: Token -> IO (Either Error [Channel])
getChannels ""     = pure (Left "invalid token")
getChannels _token = pure (Right _channels)

_channels :: [Channel]
_channels =
  [ Channel "c123456" "general" (map userId _users) False
  , Channel "c123457" "random"  (map userId _users) False
  , Channel "c123458" "owners"  (map userId $ filter userAdmin _users) True
  , Channel "c123459" "secret"  (map userId $ take 2 _users) True
  ]