Headline

Modeling queries in Language:Haskell with the help of monoids

Characteristics

Several functional requirements are implemented while making explicit use the monoids. For instance, Feature:Total is implemented with the help of the sum monoid. Only those functional requirements are implemented that indeed may benefit from monoids as such. For instance, Feature:Cut is not implemented.

Illustration

Consider the implementation of Feature:Total:

-- | Total all salaries in a company
total :: Company -> Float
total (n, ds) = getSum (mconcat (map totalD ds))
  where
    -- Total all salaries in a department
    totalD :: Department -> Sum Float
    totalD (Department _ m ds es)
      = mconcat (totalE m : map totalD ds ++ map totalE es)
      where
        -- Extract the salary from an employee
        totalE :: Employee -> Sum Float
        totalE (_, _, s) = Sum s

That is, lists of departments and employees are processed by the map function resulting in lists of intermediate results in the monoid's Sum type to be reduced accordingly by the monoid's mconcat operation, which, in turn, is uniformly defined by applying the fold function to the monoid's binary operation and its identity.

Relationships

Architecture

There are these modules:

{-| A data model for the 101companies System -}

module Company.Data where

-- | A company consists of name and top-level departments
type Company = (Name, [Department])

-- | A department consists of name, manager, sub-departments, and employees
data Department = Department Name Manager [Department] [Employee]
 deriving (Eq, Read, Show)

-- | An employee consists of name, address, and salary
type Employee = (Name, Address, Salary)

-- | Managers as employees
type Manager = Employee

-- | Names of companies, departments, and employees
type Name = String

-- | Addresses as strings
type Address = String

-- | Salaries as floats
type Salary = Float
: a data model for Feature:Hierarchical company
{- | Sample data of the 101companies System -}

module Company.Sample where

import Company.Data

-- | A sample company useful for basic tests
sampleCompany :: Company
sampleCompany =
  ( "Acme Corporation",
    [
      Department "Research"
        ("Craig", "Redmond", 123456)
        []
        [
          ("Erik", "Utrecht", 12345),
          ("Ralf", "Koblenz", 1234)
        ],
      Department "Development"
        ("Ray", "Redmond", 234567)
        [
          Department "Dev1"
            ("Klaus", "Boston", 23456)
            [
              Department "Dev1.1"
                ("Karl", "Riga", 2345)
                []
                [("Joe", "Wifi City", 2344)]
            ]
            []
        ]
        []
    ]
  )
: a sample company
{-| The operation of totaling all salaries of all employees in a company -}

module Company.Total where

import Company.Data
import Data.Monoid

-- | Total all salaries in a company
total :: Company -> Float
total (n, ds) = getSum (mconcat (map totalD ds))
  where
    -- Total all salaries in a department
    totalD :: Department -> Sum Float
    totalD (Department _ m ds es)
      = mconcat (totalE m : map totalD ds ++ map totalE es)
      where
        -- Extract the salary from an employee
        totalE :: Employee -> Sum Float
        totalE (_, _, s) = Sum s
: the implementation of Feature:Total
{-| The operation to compute the nesting depth of departments in a company -}

module Company.Depth where

import Company.Data
import Data.Monoid
import Data.Max

-- | Compute the nesting depth of a company
depth :: Company -> Int
depth (_, ds) = max' (map depth' ds)
  where
    -- Maximum of a list of natural numbers
    max' = maybe 0 id . getMax . mconcat 
    -- Helper at the department level
    depth' :: Department -> Max Int
    depth' (Department _ _ ds _) = setMax (1 + max' (map depth' ds))
: the implementation of Feature:Depth
{-| The constraint to check that salaries follow ranks in company hierarchy -}

module Company.Ranking where

import Company.Data
import Data.Monoid
import Data.Max

-- | Check that salaries follow ranks in company hierarchy
ranking :: Company -> Bool
ranking (_, ds) = and (map ranking' ds)
  where
    -- Helper at the department level
    ranking' :: Department -> Bool
    ranking' (Department _ m ds es)
        =  and (map ranking' ds)
        && maybe True (<getSalary m) (getMax subunits)
      where
        -- Maximum of salaries for immediate employees
        employees :: Max Float
        employees = mconcat (map (setMax . getSalary) es)
        -- Maximum of salaries for immediate sub-departments' managers
        managers :: Max Float
        managers = mconcat (map (setMax . getManagerSalary) ds)
        -- "employees" and "managers" combined       
        subunits :: Max Float
        subunits = managers `mappend` employees
    -- Extract the salary of a department's manager
    getManagerSalary :: Department -> Float
    getManagerSalary (Department _ m _ _) = getSalary m
    -- Extract the salary of an employee
    getSalary :: Employee -> Float
    getSalary (_, _, s) = s

-- | A company that violates the ranking constraint
rankingFailSample =
  ( "Fail Industries",
    [ Department "Failure"
        ("Ubermanager", "Top Floor", 100)
        []
        [("Joe Programmer", "Basement", 1000)]
    ]
  )
: the implementation of Feature:Ranking
{-| A monoid for optional maxima -}

module Data.Max (
  Max,
  getMax,
  setMax,
  noMax
) where

import Data.Monoid

-- | A data type for maxima without default
data Ord x => 
     Max x = Max {
       -- | Retrieve maximum, if any
       getMax :: Maybe x 
     }

-- | Set max to "just" a value
setMax :: Ord x => x -> Max x
setMax = Max . Just

-- | The absent maximum
noMax :: Ord x => Max x
noMax = Max { getMax = Nothing }

-- | A monoid for maxima
instance Ord x => Monoid (Max x)
  where
    mempty = Max Nothing
    x `mappend` y
      = case (getMax x, getMax y) of
          (Nothing, m) -> Max m
          (m, Nothing) -> Max m
          (Just m1, Just m2) -> Max (Just (m1 `max` m2))
: a monoid for optional maxima
{-| Tests for the 101companies System -}

module Main where

import Company.Data
import Company.Sample
import Company.Total
import Company.Depth
import Company.Ranking
import Test.HUnit
import System.Exit

-- | Compare salary total of sample company with baseline
totalTest = 399747.0 ~=? total sampleCompany

-- | Compare depth of sample company with baseline
depthTest = 3 ~=? depth sampleCompany

-- | Check ranking constraint for salaries of sample company
rankingOkTest =  True ~=? ranking sampleCompany

-- | Negative test case for ranking constraint
rankingFailTest = False ~=? ranking rankingFailSample

-- | Test for round-tripping of de-/serialization of sample company
serializationTest = sampleCompany ~=? read (show sampleCompany)

-- | The list of tests
tests =
  TestList [
    TestLabel "total" totalTest,
    TestLabel "depth" depthTest,
    TestLabel "rankingOk" rankingOkTest,
    TestLabel "rankingFail" rankingFailTest,
    TestLabel "serialization" serializationTest
  ]

-- | Run all tests and communicate through exit code
main = do
 counts <- runTestTT tests
 if (errors counts > 0 || failures counts > 0)
   then exitFailure
   else exitSuccess
: Tests The types of
{-| A data model for the 101companies System -}

module Company.Data where

-- | A company consists of name and top-level departments
type Company = (Name, [Department])

-- | A department consists of name, manager, sub-departments, and employees
data Department = Department Name Manager [Department] [Employee]
 deriving (Eq, Read, Show)

-- | An employee consists of name, address, and salary
type Employee = (Name, Address, Salary)

-- | Managers as employees
type Manager = Employee

-- | Names of companies, departments, and employees
type Name = String

-- | Addresses as strings
type Address = String

-- | Salaries as floats
type Salary = Float
implement Feature:Closed serialization through Haskell's read/show.

Usage

See https://github.com/101companies/101haskell/blob/master/README.md.


Kevin edited this article at Fri, 02 Jun 2017 00:10:09 +0200
Compare revisions Compare revisions

User contributions

    This user never has never made submissions.

    User edits

    Syntax for editing wiki

    For you are available next options:

    will make text bold.

    will make text italic.

    will make text underlined.

    will make text striked.

    will allow you to paste code headline into the page.

    will allow you to link into the page.

    will allow you to paste code with syntax highlight into the page. You will need to define used programming language.

    will allow you to paste image into the page.

    is list with bullets.

    is list with numbers.

    will allow your to insert slideshare presentation into the page. You need to copy link to presentation and insert it as parameter in this tag.

    will allow your to insert youtube video into the page. You need to copy link to youtube page with video and insert it as parameter in this tag.

    will allow your to insert code snippets from @worker.

    Syntax for editing wiki

    For you are available next options:

    will make text bold.

    will make text italic.

    will make text underlined.

    will make text striked.

    will allow you to paste code headline into the page.

    will allow you to link into the page.

    will allow you to paste code with syntax highlight into the page. You will need to define used programming language.

    will allow you to paste image into the page.

    is list with bullets.

    is list with numbers.

    will allow your to insert slideshare presentation into the page. You need to copy link to presentation and insert it as parameter in this tag.

    will allow your to insert youtube video into the page. You need to copy link to youtube page with video and insert it as parameter in this tag.

    will allow your to insert code snippets from @worker.