Initial failing tests.

[?]

Jan 13, 2014, 4:33 AM

NVOCQVASZWTKQJG7GPH7KHKZZR7NUG4WLV5YY4KAIRPCJRWCZPIAC

Dependencies

[2] ADMKQQGC Initial empty Snap project.
[*] AXKKXBWN Initial attempt at writing down my ideas for a company based on trust.

Change contents

edit in .gitignore at line 4

[2.176]

*.swp
dist
replacement in ananke.cabal at line 3

[2.267]→[2.267:356](∅→∅)

Synopsis: Project Synopsis Here
Description: Project Description Here

[2.267]

[2.356]

Synopsis: The Ananke Collaboration Platform
Description: A service to enable groups of trusted contributors to be paid for their efforts in collaboratively developing commercial applications.
replacement in ananke.cabal at line 6

[2.395]→[2.395:467](∅→∅)

Author: Author
Maintainer: maintainer@example.com

[2.395]

[2.467]

Author: Kris Nuttycombe
Maintainer: kris@hylotech.com
replacement in ananke.cabal at line 36

[2.1334]→[2.1334:1371](∅→∅)

xmlhtml >= 0.1

[2.1334]

[2.1371]

iso8601-time == 0.1.1,
xmlhtml >= 0.1,
containers == 0.5.*,
postgresql-simple >= 0.3.10,
snaplet-postgresql-simple >= 0.4.1
edit in ananke.cabal at line 68

[2.2387]

Test-Suite test-ananke
type: exitcode-stdio-1.0
main-is: Test.hs
hs-source-dirs: test, src
build-depends: base >=4.6 && <4.7,
test-framework,
test-framework-hunit,
HUnit,
containers == 0.5.*
file addition: Ananke (d--r------)

[2.4286]
file addition: TimeLog.hs (----------)

[0.826]

{-# LANGUAGE DeriveDataTypeable #-}

module Ananke.TimeLog
( LogEntry(..)
, LogInterval(..)
, LogEvent(..)
, payouts
, intervals
) where

import Ananke
import Data.Map
import Data.Time.Clock
import Data.Typeable.Internal
import Database.PostgreSQL.Simple.FromRow
import Database.PostgreSQL.Simple.FromField
import Control.Applicative
import Control.Exception.Base

data LogEvent = StartWork | StopWork deriving (Show, Eq)

data LogEventParseError = LogEventParseError String deriving (Show, Typeable)

instance Exception LogEventParseError where

instance FromField LogEvent where
fromField f m = let fromText "start_work" = return StartWork
fromText "stop_work" = return StopWork
fromText a = conversionError $ LogEventParseError $ "unrecognized log event type " ++ a
in fromField f m >>= fromText

data LogEntry = LogEntry { btcAddr :: BtcAddr
, logTime :: UTCTime
, event :: LogEvent
} deriving (Show, Eq)

data LogInterval = LogInterval { intervalBtcAddr :: BtcAddr
, start :: UTCTime
, end :: UTCTime
} deriving (Show, Eq)

instance Ord LogEntry where
compare a b = compare (logTime a) (logTime b)

instance FromRow LogEntry where
fromRow = LogEntry <$> field <*> field <*> field

payouts :: [LogEntry] -> Map BtcAddr Rational
payouts = undefined

intervals :: [LogEntry] -> [LogInterval]
intervals e = undefined
file addition: Ananke.hs (----------)

[2.4286]

module Ananke
( BtcAddr(address)
, btcAddr
) where

import qualified Data.Text as T
import Database.PostgreSQL.Simple.FromField

newtype BtcAddr = BtcAddr { address :: T.Text } deriving (Show, Eq)

btcAddr :: T.Text -> Maybe BtcAddr
btcAddr = Just . BtcAddr -- this will be changed to do validation

instance FromField BtcAddr where
fromField f m = fmap BtcAddr $ fromField f m
edit in src/Application.hs at line 14

[2.4734]

[2.4734]

import Snap.Snaplet.PostgresqlSimple
edit in src/Application.hs at line 21

[2.4944]

[2.4944]

, _db :: Snaplet Postgres
edit in src/Site.hs at line 21

[2.10993]

[2.10993]

import Snap.Snaplet.PostgresqlSimple
edit in src/Site.hs at line 27

[2.11201]

[2.11201]

import Ananke
import Ananke.TimeLog
edit in src/Site.hs at line 88

[2.13512]

[2.13512]

pg <- nestSnaplet "pg" db pgsInit
replacement in src/Site.hs at line 91

[2.13559]→[2.13559:13582](∅→∅)

return $ App h s a

[2.13559]

[2.13582]

return $ App h s a pg
file addition: sql (d--r------)

[2.4286]
file addition: ananke.sql (----------)

[0.3127]

create table users (
btc_addr varchar(34) primary key
);

create table users_trusted (
id serial primary key,
btc_addr varchar(34) references users (btc_addr) not null,
trust_interval interval not null
)

create type event_type as enum ('start_work', 'stop_work');

create table timelog (
id serial primary key,
btc_addr varchar(34) references users (btc_addr) not null,
log_time timestamp without time zone not null,
log_type event_type not null
)
file addition: test (d--r------)

[4.2]
file addition: Test.hs (----------)

[0.3647]

import Test.HUnit
import Test.Framework
import Test.Framework.Providers.HUnit
import Data.Monoid
import Data.Maybe
import Control.Monad
import Ananke
import Ananke.TimeLog
import Data.Time.ISO8601
import qualified Data.Text as T

deriveIntervalsTest :: Assertion
deriveIntervalsTest = let
testAddrs = catMaybes [ Ananke.btcAddr $ T.pack "123"
, Ananke.btcAddr $ T.pack "456"
, Ananke.btcAddr $ T.pack "789" ]

starts = catMaybes [ parseISO8601 "2014-01-01T00:08:00Z"
, parseISO8601 "2014-02-12T00:12:00Z" ]

ends = catMaybes [ parseISO8601 "2014-01-01T00:12:00Z"
, parseISO8601 "2014-02-12T00:18:00Z" ]
testLogEntries = do
addr <- testAddrs
(start, end) <- zip starts ends
[ LogEntry addr start StartWork, LogEntry addr end StopWork ]
expected = do
addr <- testAddrs
(start, end) <- zip starts ends
[ LogInterval addr start end ]

in assertEqual "derive log entries" (intervals testLogEntries) expected

main :: IO ()
main = defaultMainWithOpts
[testCase "deriveIntervals" deriveIntervalsTest]
mempty