instance functor :: Functor MeasuredTask where
map f (MeasuredTask mt) = MeasuredTask (f mt)
complains that
Could not match kind
Type -> Type
with kind
Type
while checking the kind of Functor MeasuredTask
derive instance functorMeasuredTask :: Functor MeasuredTask
data
with newtype
for MeasuredTask
since it wraps only one single value
MeasuredMask
don’t have any type argument to map
changeTask :: EndEvent -> MeasuredTask -> Maybe MeasuredTask
changeTask s (MeasuredTask task) =
Just $ MeasuredTask $ task { timeEnd = s.time, cpuEnd = s.cpuTicks, cpuThread = task.cpuThread + s.cpuTicks }
Type
https://pursuit.purescript.org/packages/purescript-newtype/3.0.0/docs/Data.Newtype#t:Newtype
newtype Label = Label String
derive instance newtypeLabel :: Newtype Label _
toUpperLabel :: Label -> Label
toUpperLabel = over Label String.toUpper
type XYZ = (Int, String)
I'm trying to build a state monad but I get a RangeError due to maximum call stack size exceeded, my code is :
type ProcessEventContext = Tuple (Map Int MeasuredTask) (Int)
processStartEvent :: StartEvent -> State (ProcessEventContext) (Map Int MeasuredTask)
processStartEvent s = do
state <- get
let map = fst state
let stack = snd state
pure $ map
processStopEvent :: EndEvent -> State (ProcessEventContext) (Map Int MeasuredTask)
processStopEvent s = do
state <- get
let map = fst state
let stack = snd state
pure $ map
processTickEvent :: TickEvent -> State (ProcessEventContext) (Map Int MeasuredTask)
processTickEvent s = do
state <- get
let map = fst state
let stack = snd state
pure $ map
processDoNothing :: State (ProcessEventContext) (Map Int MeasuredTask)
processDoNothing = do
state <- get
let map = fst state
let stack = snd state
pure $ map
updateMap old (Start s) = processStartEvent s
updateMap old (Stop s) = processStopEvent s
updateMap old (Tick s) = processTickEvent s
updateMap old (_) = processDoNothing
eventToTaskM :: Array Event -> State (ProcessEventContext) (Map Int MeasuredTask)
eventToTaskM list = do
_ <- foldM updateMap empty list
result <- get
pure $ fst result
eventToTask :: Array Event -> Map Int MeasuredTask
eventToTask list =
fst $ runState (eventToTaskM list) (Tuple empty 0)
Is there a way to circumvent the issue ? I suspect it's due to foldM (the list has 100000s events)
actually I'm struggling with something else entirely, the state monad doesn't do what I'm expecting it do to. Here is the code :
type ProcessEventContext = Tuple (Map Int MeasuredTask) (Int)
processStartEvent :: StartEvent -> State (ProcessEventContext) Unit
processStartEvent s = do
old <- gets fst
stack <- gets snd
let updatedMap = (insert (s.iD) (createStartInfo s) old)
put $ Tuple updatedMap stack
processStopEvent :: EndEvent -> State (ProcessEventContext) Unit
processStopEvent s = do
state <- get
let old = fst state
let stack = snd state
let updatedMap = update (changeTask s) s.taskStartId old
put $ Tuple updatedMap stack
processDoNothing :: State (ProcessEventContext) Unit
processDoNothing = do
pure unit
updateMap (Start s) = processStartEvent s
updateMap (Stop s) = processStopEvent s
updateMap (Tick s) = processDoNothing
updateMap (_) = processDoNothing
eventToTaskM :: Array Event -> State (ProcessEventContext) (Map Int MeasuredTask)
eventToTaskM arr = do
let filtered = \x -> case x of Tick _ -> false
_ -> true
let filteredEvents = (take 1000 $ filter filtered arr :: Array Event)
_ <- sequence_ $ updateMap <$> filteredEvents
result <- get
pure $ fst result
eventToTask :: Array Event -> Map Int MeasuredTask
eventToTask list =
evalState (eventToTaskM list) (Tuple empty 0)
But I always end up with a single item in the map. It looks like the squence is discarding the state
computeLinkedData :: Map Int MeasuredTask -> Map Int MeasuredTask
computeLinkedData map =
foldl propagateLink map map
where
updateTask old task@(MeasuredTask realMt) =
let linkedTasksFromMap = catMaybes $ (\x -> lookup x old) <$> view _uid <$> realMt.linkedTasks in
let s = sum $ (\x -> view _cpuThread x) <$> linkedTasksFromMap in
Just $ (over _cpuLinked ((+) s)) <<< (set _linkedTasks linkedTasksFromMap) $ task
propagateLink old (MeasuredTask mt) =
let mtId = mt.uid in
let partlyUpdatedMap = foldl propagateLink old mt.linkedTasks in
update (updateTask partlyUpdatedMap) mtId partlyUpdatedMap
I added an "update task" function it wasn't there initially
computeLinkedData :: Map Int MeasuredTask -> Map Int MeasuredTask
computeLinkedData map =
foldl propagateLink map map
where
updateTask old task@(MeasuredTask realMt) =
let
linkedTasksFromMap = catMaybes $ (\x -> lookup x old) <$> view _uid <$> realMt.linkedTasks
s = sum $ (\x -> view _cpuThread x) <$> linkedTasksFromMap
in
Just $ (over _cpuLinked ((+) s)) <<< (set _linkedTasks linkedTasksFromMap) $ task
propagateLink old (MeasuredTask mt) =
let
mtId = mt.uid
partlyUpdatedMap = foldl propagateLink old mt.linkedTasks
in
update (updateTask partlyUpdatedMap) mtId partlyUpdatedMap
where
section again:computeLinkedData :: Map Int MeasuredTask -> Map Int MeasuredTask
computeLinkedData map =
foldl propagateLink map map
where
updateTask old task@(MeasuredTask realMt) =
Just $ (over _cpuLinked ((+) s)) <<< (set _linkedTasks linkedTasksFromMap) $ task
where
linkedTasksFromMap = catMaybes $ (\x -> lookup x old) <$> view _uid <$> realMt.linkedTasks
s = sum $ (\x -> view _cpuThread x) <$> linkedTasksFromMap
propagateLink old (MeasuredTask mt) =
update (updateTask partlyUpdatedMap) mtId partlyUpdatedMap
where
mtId = mt.uid
partlyUpdatedMap = foldl propagateLink old mt.linkedTasks