module HAX.Common (
Amount
, Comment
, range1
, bounds1
, range2
, bounds2
, updateArray
, assocArray
, when'
, both
, conv
, positivePart
, assert
, PList(..)
, ADate()
, date
, endOfYear
, month
, yearMonth
, getMonth
, getYear
, ASpan(..)
, months
, yearMonthSpan
, yearSpan
, divides
, dateSpan
, shift
,module Control.Applicative
,module Control.Arrow
,module Control.Monad
,module Control.Monad.RWS.Strict
,module Data.Array
,module Data.Array.IO
,module Data.Decimal
,module Data.Function
,module Data.List
,module Data.Maybe
,module Data.Monoid
,module Data.Ord
,module Data.Ratio
,module Data.String
,module Data.Tuple
,module Text.Printf
,module Text.Show
) where
import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.RWS.Strict
import Control.Monad.Trans (lift)
import Data.Array
import Data.Array.IO
import Data.Decimal
import Data.Function
import Data.List hiding (span)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import Data.String
import Data.Tuple
import Prelude hiding (span)
import Text.Printf
import Text.Show
type Amount = Decimal
type Comment = String
data ADate = UNSAFE_ADate { dUNSAFE_Months :: Int
}
deriving (Eq,Ord,Ix)
data ASpan = ASpan { sMonths :: Int
}
deriving (Eq,Ord,Ix)
getMonth :: ADate -> Int
getMonth = snd . yearMonth
getYear :: ADate -> Int
getYear = fst . yearMonth
yearMonth :: ADate -> (Int , Int)
yearMonth (UNSAFE_ADate m) = second succ $ m `divMod` 12
endOfYear :: Int -> ADate
endOfYear y = UNSAFE_ADate $ 12 * (y+1) 1
month :: Int -> ADate
month m = if m >12 || m<1 then error $ printf "Bad Month: %v" m
else UNSAFE_ADate $ m 1
months :: Int -> ASpan
months = ASpan
yearMonthSpan :: ASpan -> (Int , Int)
yearMonthSpan (ASpan m) = m `divMod` 12
yearSpan :: ASpan -> Int
yearSpan = fst . yearMonthSpan
dateSpan :: ADate
-> ADate
-> ASpan
dateSpan a b = ASpan $ on () dUNSAFE_Months b a
shift :: ASpan -> ADate -> ADate
shift s d = UNSAFE_ADate $ dUNSAFE_Months d + sMonths s
date :: Int -> Int -> ADate
date m y = if y < 1800 then error $ printf "Year %v is earlier than 1800???" y
else shift (ASpan $ 12 * y) $ month m
instance Show ASpan where
show s= show (sMonths s) ++ " months"
instance Show ADate where
show = (\(y,m) -> printf "%2d/%02d" m $ y`mod` 100) . yearMonth
instance PrintfArg (PList Decimal) where
formatArg ds _ = showListWith showsD $ pList ds
newtype PList a = PList { pList :: [a] }
instance PrintfArg ADate where
formatArg = formatString . show
divides :: ASpan -> ASpan -> Bool
divides a b = forSpan2 mod b a == 0
forSpan2 f = (ASpan .) . on f sMonths
forSpan1 f = ASpan . f . sMonths
instance Num ASpan where
(+) = forSpan2 (+)
(*) = forSpan2 (*)
() = forSpan2 ()
fromInteger = ASpan . fromInteger
abs = forSpan1 abs
signum = forSpan1 signum
updateArray :: (MArray a e m, Ix i) => a i e -> i -> (e->e) -> m ()
updateArray a i f = readArray a i >>= writeArray a i . f
instance (Show a, Integral a) => PrintfArg (DecimalRaw a) where
formatArg d _ = showsD d
showsD = shows . roundTo 2 . (/1000)
range1 = range . bounds1
bounds1 = both fst
range2 = range . bounds2
bounds2 = both snd
both :: (b -> c) -> (b, b) -> (c, c)
both = join (***)
bothM :: Monad m => (b -> m c) -> (b, b) -> m (c, c)
bothM f (a,b) = do a' <- f a
b' <- f b
return (a',b')
when' :: Num a => Bool -> a -> a
when' a b = if a then b else 0
conv :: (Real a, Fractional c) => a -> c
conv = (fromRational . toRational)
assocArray :: Ix i =>
[(i, e)]
-> Array i e
assocArray assocs = array (minimum indx,maximum indx) assocs
where indx = fst <$> assocs
positivePart a = max a 0
assert condition getAm msg = do
am <- getAm
when (not $ condition am) $ lift $ putStrLn $ "ASSERTION FAILED: " ++ msg
return am