Domain.hs

{-# LANGUAGE OverloadedStrings #-}

module Domain ( AreaRole, RoleToAreas, groupByIdentityType ) where

import Data.Function (on)
import Data.List (sortBy, groupBy)
import Data.Ord (comparing)

data AreaRole = AreaRole {
    role :: String,
    description :: String,
    area :: String
} deriving (Show)
        
data RoleToAreas = RoleToAreas {
    idRole :: String,
    idDescription :: String,
    areas :: [String]
} deriving (Show)

sortByFirstElementOfTupleType :: [AreaRole] -> [AreaRole]
sortByFirstElementOfTupleType = sortBy (comparing role)

groupByFirstElementOfTupleType ::[AreaRole] -> [[AreaRole]]
groupByFirstElementOfTupleType = groupBy ((==) `on` role) 

mergeByIdentityType :: [[AreaRole]] -> [RoleToAreas]
mergeByIdentityType = map (\l -> RoleToAreas (role . head $ l) (description . head $ l) (map area l))

groupByIdentityType ::[AreaRole] -> [RoleToAreas]
groupByIdentityType = mergeByIdentityType . groupByFirstElementOfTupleType . sortByFirstElementOfTupleType

GetDataFromDb.hs

{-# LANGUAGE OverloadedStrings #-}

module GetDataFromDb( getDataFromDb) where

import Domain (AreaRole(..))
import Database.MySQL.Base
import Data.Text (unpack, pack)
import qualified System.IO.Streams as S
import System.Environment

import qualified Data.ByteString as B
import Data.Text.Encoding (encodeUtf8)

packString :: String -> B.ByteString
packString = encodeUtf8 . pack

getDataFromDb :: String -> String -> String -> String -> IO [AreaRole]
getDataFromDb host user password schema = do
    conn <- connect defaultConnectInfo { ciHost = host, ciUser = packString user, ciPassword = packString password, ciDatabase = packString schema}
    (defs, is) <- query_ conn "SELECT a.ID_ROLE, b.DESCRIPTION, a.ID_AREA FROM BO_ROLE_AREAS a, BO_ROLES b WHERE a.ID_ROLE = b.ID_ROLE"
    myList <- S.toList is
    return $ map (\(MySQLText idRole:MySQLText description:MySQLText idArea:_) -> AreaRole (unpack idRole) (unpack description) (unpack idArea)) myList