diff --git a/src/Constraint.elm b/src/Constraint.elm index 37ca085..53991ee 100644 --- a/src/Constraint.elm +++ b/src/Constraint.elm @@ -1,15 +1,27 @@ -module Constraint exposing (Model, focusOn, init, positions, unfocus, updateAttachments) +module Constraint exposing (Model, focusOn, init, positions, unfocus, updateIdealPositions) import Dict exposing (Dict) +{-| Lay out comments according to these constraints: + +1. if there is a focused comment, it must be at it's ideal position +2. comments may not overlap +3. comments should be as close as possible to their ideal position (but the + first comment in an otherwise-overlapping sequence should be at it's ideal position) + +Notably missing here: the ability to add new comments. That's just not something +that we need to solve for yet. Once we do, it should not be too hard to add +(recalculate the `comments` ordering with respect to the new height and ideal +position data, and re-solve.) + +-} type Model = Model - { -- comment ID to comment height - heights : Dict Int Float - - -- comment ID to ideal position - , attachments : Dict Int Float + { -- comment ID to dimensions. This needs to be sorted by idealPosition + -- since this algorithm will be walking the data that way several + -- times. + comments : List ( Int, { height : Float, idealPosition : Float } ) -- comment ID to actual position , positions : Dict Int Float @@ -24,14 +36,23 @@ type Model init : { heights : Dict Int Float - , attachments : Dict Int Float + , idealPositions : Dict Int Float , margin : Float } -> Model -init { heights, attachments, margin } = +init { heights, idealPositions, margin } = Model - { heights = heights - , attachments = attachments + { comments = + -- take the intersection of the heights and ideal positions. Gotta have both for a comment to do this algorithm! + Dict.merge + (\_ _ result -> result) + (\key height idealPosition -> Dict.insert key { height = height, idealPosition = idealPosition }) + (\_ _ result -> result) + heights + idealPositions + Dict.empty + |> Dict.toList + |> List.sortBy (\( _, { idealPosition } ) -> idealPosition) , positions = Dict.empty , margin = margin , focus = Nothing @@ -53,16 +74,9 @@ solveWithoutFocus (Model guts) = Model { guts | positions = - guts.attachments - |> Dict.toList - |> List.sortBy Tuple.second + guts.comments |> List.foldl - (\( id, idealPosition ) ( finalPositions, progressLine ) -> - let - height = - Dict.get id guts.heights - |> Maybe.withDefault 0 - in + (\( id, { idealPosition, height } ) ( finalPositions, progressLine ) -> if idealPosition >= progressLine then ( Dict.insert id idealPosition finalPositions , idealPosition + height + guts.margin @@ -87,20 +101,13 @@ solveWithFocus (Model guts) = solveWithoutFocus (Model guts) ( goUp, goDown ) = - newGuts.attachments - |> Dict.toList - |> List.sortBy Tuple.second - -- == 0 is a trick to get the compiler to generate - -- more efficient code. Will not always be needed! - |> splitAtReversing (\( curId, _ ) -> curId - id == 0) + -- == 0 is a trick to get the compiler to generate + -- more efficient code. Will not always be needed! + splitAtReversing (\( curId, _ ) -> curId - id == 0) newGuts.comments ( downwardPositions, _ ) = List.foldl - (\( curId, idealPosition ) ( finalPositions, progressLine ) -> - let - height = - Dict.get curId newGuts.heights |> Maybe.withDefault 0 - in + (\( curId, { height, idealPosition } ) ( finalPositions, progressLine ) -> if idealPosition >= progressLine then ( Dict.insert curId idealPosition finalPositions , idealPosition + height + newGuts.margin @@ -116,11 +123,8 @@ solveWithFocus (Model guts) = ( downwardAndUpwardPositions, _ ) = List.foldl - (\( curId, idealPosition ) ( finalPositions, progressLine ) -> + (\( curId, { height, idealPosition } ) ( finalPositions, progressLine ) -> let - height = - Dict.get curId newGuts.heights |> Maybe.withDefault 0 - currentPosition = Dict.get curId newGuts.positions |> Maybe.withDefault idealPosition in @@ -140,8 +144,8 @@ solveWithFocus (Model guts) = ) ( downwardPositions , case goDown of - ( _, start ) :: _ -> - start + ( _, { idealPosition } ) :: _ -> + idealPosition _ -> -- infinity @@ -155,13 +159,21 @@ solveWithFocus (Model guts) = solveWithFocus (Model guts) -updateAttachments : Dict Int Float -> Model -> Model -updateAttachments attachments (Model guts) = - if attachments == guts.attachments then - Model guts - - else - Model { guts | attachments = attachments } |> solve +updateIdealPositions : Dict Int Float -> Model -> Model +updateIdealPositions attachments (Model guts) = + Model + { guts + | comments = + guts.comments + |> List.filterMap + (\( id, metrics ) -> + Maybe.map + (\newIdealPosition -> ( id, { metrics | idealPosition = newIdealPosition } )) + (Dict.get id attachments) + ) + |> List.sortBy (\( _, { idealPosition } ) -> idealPosition) + } + |> solve focusOn : Int -> Model -> Model diff --git a/src/Main.elm b/src/Main.elm index e32b43a..d780f6d 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -97,7 +97,7 @@ update msg model = ( { model | commentPositions = Maybe.map - (Constraint.updateAttachments (finalAttachments attachments)) + (Constraint.updateIdealPositions (idealPositionsFor attachments)) model.commentPositions } , Cmd.none @@ -109,7 +109,7 @@ update msg model = Just <| Constraint.init { heights = Dict.fromList commentHeights - , attachments = finalAttachments attachments + , idealPositions = idealPositionsFor attachments , margin = 10 } } @@ -133,8 +133,8 @@ update msg model = ) -finalAttachments : List ( Int, Float ) -> Dict Int Float -finalAttachments = +idealPositionsFor : List ( Int, Float ) -> Dict Int Float +idealPositionsFor = List.foldl (\( commentId, top ) soFar -> Dict.update commentId