Hello all, I have these Types type Time = Integer data Change a = Chg { ct :: Time, -- "change time" cv :: a -- "change value" } deriving (Eq,Show) data Temporal a = Temporal { td :: a, -- "temporal default" tc :: [Change a] -- "temporal changes" } deriving (Eq, Show) And I am trying to make Temporal a Monad by implementing join. My first Attempt was awfully verbose. It was also faulty, which was revealed by this QuickQueck (I am happy with my implementation of <*>) prop_tJoin tpr1 tpr2 = let f = (*) y1 = f <$> tpr1 <*> tpr2 y2 = (f <$> tpr1) `ap` tpr2 in y1 == y2 While I understand why my first implementatin was faulty, I fail to come up with anything remotely readable. I don't understand why I am having such difficulties, let alone solve them. I feel I am approaching this from the wrong angle. Any advice would be very much appreciated.
So I have a solution now, it passes my tests but it is ugly. While I am unnesting I sometimes have to add the default as a new change and sometimes add the last old change with its time advanced. The problem is, I don't really know the semantics of a Temporal Temporal, but I know the semantics of <*> and that <*> must be the same as `ap`. Any comments will be very welcome. -- cBetween :: Time -> Time -> [Change a] -> [Change a] -- cAfter :: Time -> [Change a] -> [Change a] -- cBefore :: Time -> [Change a] -> [Change a] tJoin :: Temporal (Temporal a) -> Temporal a tJoin (Temporal tdef []) = tdef tJoin tp@(Temporal tdef ctps) | null cs' = Temporal (td tdef) (tj ctps) | otherwise = Temporal (td tdef) (cs' ++ tj' ctps) where cs = tc tdef cs' = cBefore (ct $ head ctps) cs tj, tj' :: [Change (Temporal a)] -> [Change a] -- before first change was found tj ((Chg t (Temporal d [])):[]) = [Chg t d] tj ((Chg t (Temporal d cs)):[]) = preDef t d cs (cAfter t cs) tj ((Chg t (Temporal d [])):cts) = (Chg t d) : (tj cts) tj ((Chg t (Temporal d cs)):cts) | null cs' = preDef t d cs (tj cts) | otherwise = preDef t d cs cs' ++ (tj' cts) where cs' = cBetween t (ct $ head cts) cs -- after first change was found tj' ((Chg t (Temporal d cs)):[]) = preC0 t cs (cAfter t cs) tj' ((Chg t (Temporal d cs)):cts) = preC0 t cs cs' ++ (tj' cts) where cs' = cBetween t (ct $ head cts) cs -- prepend first change if required preC0 t cs cs' | null bef = cs' | tx == t = cs' | otherwise = (Chg t vx) : cs' where bef = cBefore' t cs (Chg tx vx) = last bef -- prepend default as new change preDef t d cs cs' | null cs = cs' | t == tx = cs' | otherwise = (Chg t d) : cs' where (Chg tx vx) = head cs Am 04/10/2015 um 07:02 PM schrieb martin:
type Time = Integer data Change a = Chg { ct :: Time, -- "change time" cv :: a -- "change value" } deriving (Eq,Show)
data Temporal a = Temporal { td :: a, -- "temporal default" tc :: [Change a] -- "temporal changes" } deriving (Eq, Show)
participants (1)
-
martin