NVOCQVASZWTKQJG7GPH7KHKZZR7NUG4WLV5YY4KAIRPCJRWCZPIAC
*.swp
dist
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.*
{-# 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
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
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
)
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