Grabs.hs

{-# OPTIONS_GHC -Wall #-}

{-# LANGUAGE

    ApplicativeDo, BlockArguments, LambdaCase,
    OverloadedStrings, ScopedTypeVariables, ViewPatterns

#-}

module Test.OrgRoster.Grabs where

import Test.OrgRoster.Concepts

import qualified Data.GrabForm as Grab
import Data.GrabForm (only, natList, at, checkbox, text, optionalText, natListWithIndex)

import Data.Bifunctor

import qualified Data.Map as Map
import Data.Map (Map)

type Error = Grab.EnglishSentence
type Grab desideratum = Grab.Grab Error desideratum
type Log = Grab.Log Error
type Dump desideratum = Grab.Dump Error desideratum

roster :: Grab Roster
roster =
    Roster
        <$> at "org" (only org)
        <*> at "members" (only memberList)

org :: Grab OrgId
org = fmap OrgId text

memberList :: Grab MemberList
memberList =
    MemberList
        <$> at "existing" (only existingList)
        <*> at "new" (only (natList (only member)))

existingList :: Grab (Map RosterOrdinal Modification)
existingList =
    fmap (Map.fromList . map (first RosterOrdinal))
    (natListWithIndex (only modification))

modification :: Grab Modification
modification =
  do
    m <- member
    r <- at "remove" (only (checkbox "yes"))
    return (if r then Modification_Delete else Modification_Update m)

member :: Grab Member
member =
    Member
        <$> at "name"      (only (fmap (fmap OrgMemberName) optionalText))
        <*> at "isManager" (only (fmap isManagerRole (checkbox "yes")))
        <*> at "isUser"    (only (fmap isUserAccess (checkbox "yes")))

isManagerRole :: Bool -> OrgRole
isManagerRole =
    \case
        False -> OrgRole_Normal
        True -> OrgRole_Manager

isUserAccess :: Bool -> OrgContentAccess
isUserAccess =
    \case
        False -> OrgContentAccess_No
        True -> OrgContentAccess_Yes