Commit 3b3a93bc authored by Thorsten Wißmann's avatar Thorsten Wißmann 🐧
Browse files

Many more 0.19 migration steps...

parent 8b3f43e3
......@@ -4,6 +4,9 @@ import Array exposing (Array)
import List
import String
{-| added for elm 0.19 migration -}
flip f a b = f b a
{-| A node in an array tree. For each child of some Node,
the parent index is the Node again.
-}
......@@ -35,11 +38,11 @@ reverseChildren = onChildren List.reverse
-}
fromArray : Array a -> (a -> Maybe Int) -> ArrayTree a
fromArray arr parent =
fromArray arr parentfunc =
let
-- withParents : Array (Node a) (with the a from above)
withParents =
Array.indexedMap (\idx el -> Node idx el (parent el) []) arr
Array.indexedMap (\idx el -> Node idx el (parentfunc el) []) arr
hasFst : (Maybe x, b) -> Maybe (x,b)
hasFst (maybe_a, b) = Maybe.map (flip Tuple.pair b) maybe_a
......@@ -52,7 +55,7 @@ fromArray arr parent =
|> List.filterMap hasFst
in
List.foldr
(\(parent,child) -> Array.modify parent (prependChild child))
(\(parentnode,child) -> Array.modify parentnode (prependChild child))
withParents
registerAtParents
......@@ -61,18 +64,22 @@ fromArray arr parent =
toArray : ArrayTree a -> Array a
toArray = Array.map (.data)
mapData : (a -> b) -> Node a -> Node b
mapData f n =
{ index = n.index, data = f n.data, parent = n.parent, children = n.children }
map : (a -> b) -> ArrayTree a -> ArrayTree b
map f arr =
Array.map (\n -> { n | data = f n.data}) arr
Array.map (mapData f) arr
indexedMap : (Int -> a -> b) -> ArrayTree a -> ArrayTree b
indexedMap f arr =
Array.indexedMap (\i n -> { n | data = f i n.data}) arr
Array.indexedMap (\i n -> mapData (\olddata -> f i n.data) n) arr
mapNode : (Node a -> b) -> ArrayTree a -> ArrayTree b
mapNode f arr =
Array.map (\n -> { n | data = f n}) arr
Array.map (\n -> mapData (\olddata -> f n) n) arr
......
......@@ -10,13 +10,18 @@ import P2D exposing (..)
import Debug
import Has
import Has exposing (Has)
import Time exposing (Time,inSeconds,second)
import Time exposing (Posix,millisToPosix)
import String
import TrackA
import TrackA exposing (TrackA)
import Either
import Svg.Lazy as Svg
{-| migration to 0.19 |-}
type alias TimeT = Int
time_second = 1000 -- alias for old Time.second
toString = String.fromFloat
type Direction = Upwards | Downwards
type alias MovingFlags =
......@@ -28,9 +33,9 @@ type alias MovingFlags =
-- lower point but also contains an
-- additional RT.Further for the lower_point
, delta_len: Float -- the length of the path `delta`
, start_time : Maybe Time -- when the motion started.
, total_time : Time -- the duration of this motion
, time_passed : Time -- the time passed since `start_time`
, start_time : Maybe TimeT -- when the motion started.
, total_time : TimeT -- the duration of this motion
, time_passed : TimeT -- the time passed since `start_time`
}
type CarriageMotion
......@@ -41,7 +46,7 @@ type alias CarriageFlags =
{ selected : Bool
, label : String
, class : String
, error_until : Maybe Time
, error_until : Maybe TimeT
}
type alias Carriage =
{ flags : CarriageFlags
......@@ -63,32 +68,32 @@ hasError car =
{-|
activate the error field using the current time
-}
setError_ : Time -> CarriageFlags -> CarriageFlags
setError_ : Time.Posix -> CarriageFlags -> CarriageFlags
setError_ now flags =
-- mark the car as errornous for the next 2 seconds
{ flags | error_until = Just (now + 2 * second) }
{ flags | error_until = Just (Time.posixToMillis now + 2 * time_second) }
setError : Time -> Carriage -> Carriage
setError : Time.Posix -> Carriage -> Carriage
setError now car =
{ car | flags = setError_ now car.flags }
{-| Clear the error field if the time has progressed enough
-}
clearError_ : Time -> CarriageFlags -> CarriageFlags
clearError_ : Time.Posix -> CarriageFlags -> CarriageFlags
clearError_ now flags =
{ flags
| error_until =
case flags.error_until of
Just time ->
if time <= now then Nothing else Just time
if time <= (Time.posixToMillis now) then Nothing else Just time
Nothing -> Nothing
}
clearError : Time -> Carriage -> Carriage
clearError : Time.Posix -> Carriage -> Carriage
clearError now car =
case car.flags.error_until of
Just time ->
if time <= now
if time <= (Time.posixToMillis now)
then { car | flags = clearError_ now car.flags }
else car
Nothing ->
......@@ -158,7 +163,7 @@ carriageOffset car =
max 0.0 <| min 1.0 <|
if car.total_time <= 0
then 1.0
else car.time_passed / car.total_time
else (toFloat car.time_passed) / (toFloat car.total_time)
in
(1.0 - ratio) * car.start_offset + ratio * car.final_offset
......@@ -219,11 +224,11 @@ renderAxis (angle,center) =
width = carConfig.axisLen
r = carConfig.bumperRadius
transform =
"rotate("
++ (toString angle)
++ "," ++ (toString center.x)
++ "," ++ (toString center.y)
++ ")"
"rotate("
++ (toString angle)
++ "," ++ (toString center.x)
++ "," ++ (toString center.y)
++ ")"
in
Svg.g
[ SvgAttr.transform transform
......@@ -259,11 +264,11 @@ renderCarriageOnPath offset path attributes car =
, carConfig.axis2_offset + offset
)
offset2point offset =
RT.queryDistanceDown path offset
offset2point offset_ =
RT.queryDistanceDown path offset_
|> Maybe.andThen (\(track,offs) ->
TrackA.trackWalkDistance track (
--(if car.flags.selected then Debug.log "offset" else identity)
--(if car.flags.selected then Debug.log "offset_" else identity)
offs
)
|> Either.justRight
......@@ -285,8 +290,8 @@ renderCarriage rt attributes car =
--(\_ -> []) (Debug.log "Error: invalid car path" place)
[]
Just place ->
case place of
Just place_ ->
case place_ of
(RT.Track ta _) ->
let
track = Has.witness ta
......@@ -299,11 +304,12 @@ renderCarriage rt attributes car =
Moving m ->
renderCarriageOnPath (carriageOffset m) m.delta attributes car
animationStep : RT.LayoutedRailTree t j -> Time -> Carriage -> Carriage
animationStep rt now car =
animationStep : RT.LayoutedRailTree t j -> Time.Posix -> Carriage -> Carriage
animationStep rt now_posix car =
case car.motion of
(Moving m) ->
let
now = Time.posixToMillis now_posix
start_time = Maybe.withDefault now m.start_time
time_passed = (now - start_time)
in
......@@ -357,71 +363,71 @@ sendCarriageToSafe arg =
, delta_len = delta_len
, start_time = Nothing
, time_passed = 0
, total_time = Time.second * (delta_len / carConfig.speed)
, total_time = round (time_second * (delta_len / carConfig.speed))
}
)
Nothing ->
case (List.unprefix arg.restingpath arg.new_path) of
Nothing ->
Nothing
Just [] ->
Nothing
Just delta ->
RT.verifyPathToTrack importer arg.targetplace delta
|> Maybe.andThen (\(verified_delta,_) ->
let
delta_len =
RT.pathLength verified_delta
- 0.5 * restingtrack_len
- 0.5 * targettrack_len
in
-- Moving downwards
Just -- << Debug.log "new upwards motion"
<| Moving
{ upper_point = arg.new_path
, final_point = arg.new_path
, delta = verified_delta
, start_offset = 0.5 * targettrack_len + delta_len
, final_offset = 0.5 * targettrack_len
, delta_len = delta_len
, start_time = Nothing
, time_passed = 0
, total_time = Time.second * (delta_len / carConfig.speed)
}
)
case (List.unprefix arg.restingpath arg.new_path) of
Nothing ->
Nothing
Just [] ->
Nothing
Just delta ->
RT.verifyPathToTrack importer arg.targetplace delta
|> Maybe.andThen (\(verified_delta,_) ->
let
delta_len =
RT.pathLength verified_delta
- 0.5 * restingtrack_len
- 0.5 * targettrack_len
in
-- Moving downwards
Just -- << Debug.log "new upwards motion"
<| Moving
{ upper_point = arg.new_path
, final_point = arg.new_path
, delta = verified_delta
, start_offset = 0.5 * targettrack_len + delta_len
, final_offset = 0.5 * targettrack_len
, delta_len = delta_len
, start_time = Nothing
, time_passed = 0
, total_time = round (time_second * (delta_len / carConfig.speed))
}
)
sendCarriageTo : RT.LayoutedRailTree t j -> RT.Path -> Carriage -> Carriage
sendCarriageTo rt new_path car =
case car.motion of
(Moving _) -> car
Resting restingpath ->
let
-- run all the partial functions
--restingplace : Maybe (RT.LayoutedRailTree t j)
restingplace = RT.query rt restingpath
--targetplace : Maybe (RT.LayoutedRailTree t j)
targetplace = RT.query rt new_path
restingtrack =
restingplace
|> Maybe.andThen RT.isTrack
|> Maybe.map Has.witness
targettrack =
targetplace
|> Maybe.andThen RT.isTrack
|> Maybe.map Has.witness
in
case (restingplace,targetplace,restingtrack,targettrack) of
-- in case all previous partial functions succeeded
(Just restingplace,Just targetplace,Just restingtrack,Just targettrack) ->
-- pass them to the 'safe' variant
let
motion = Maybe.withDefault car.motion <| sendCarriageToSafe
{ new_path=new_path
, restingpath =restingpath , restingplace =restingplace , targetplace=targetplace
, restingtrack= restingtrack , targettrack=targettrack
}
in { car | motion = motion }
_ -> car
let
-- run all the partial functions
--restingplace : Maybe (RT.LayoutedRailTree t j)
restingplace = RT.query rt restingpath
--targetplace : Maybe (RT.LayoutedRailTree t j)
targetplace = RT.query rt new_path
restingtrack =
restingplace
|> Maybe.andThen RT.isTrack
|> Maybe.map Has.witness
targettrack =
targetplace
|> Maybe.andThen RT.isTrack
|> Maybe.map Has.witness
in
case ((restingplace,targetplace),restingtrack,targettrack) of
-- in case all previous partial functions succeeded
((Just restingplace_,Just targetplace_),Just restingtrack_,Just targettrack_) ->
-- pass them to the 'safe' variant
let
motion = Maybe.withDefault car.motion <| sendCarriageToSafe
{ new_path=new_path
, restingpath =restingpath , restingplace =restingplace_ , targetplace=targetplace_
, restingtrack= restingtrack_ , targettrack=targettrack_
}
in { car | motion = motion }
_ -> car
sendCarriageToInstant : RT.LayoutedRailTree t j -> RT.Path -> Carriage -> Carriage
sendCarriageToInstant rt path car = finishMotion <| sendCarriageTo rt path car
......
......@@ -14,6 +14,9 @@ module Has exposing
type Has a b =
HasContainer a b
{-| added for elm 0.19 migration -}
flip f a b = f b a
now_has : b -> a -> Has a b
now_has = flip HasContainer
......
......@@ -8,7 +8,7 @@ import Tuple
unprefix : List a -> List a -> Maybe (List a)
unprefix long short =
case (long,short) of
(long,[]) -> Just long
(longplain,[]) -> Just longplain
(head_l::tail_l,head_s::tail_s) ->
if head_l == head_s then
unprefix tail_l tail_s
......@@ -62,6 +62,8 @@ isSorted le list =
then isSorted le (a2::tail)
else False
{-| added for elm 0.19 migration -}
uncurry f (a,b) = f a b
{-| for a list with updated elements, return its index, the old and the new
value for each updated element
......@@ -79,11 +81,14 @@ differentValue xs ys =
{-| Range of integers, including the limits
-}
range : Int -> Int -> List Int
range a b =
if a <= b
then List.scanl (+) a <| List.repeat (b-a) 1
else []
range = List.range
-- range a b =
-- if a <= b
-- then List.scanl (+) a <| List.repeat (b-a) 1
-- else []
{-| added for elm 0.19 migration -}
flip f a b = f b a
{-| Map an integer list to a permutation on lists of the same length.
[a1,a2,a3¸...] means that the i'th element of the list is sent
......@@ -151,12 +156,12 @@ product la lb = List.concatMap (\a -> List.map (Tuple.pair a) lb) la
find : List a -> a -> Maybe Int
find xs needle =
let
find_acc xs needle idx =
case xs of
find_acc xs_ needle_ idx =
case xs_ of
(hd::tl) ->
if (hd == needle)
if (hd == needle_)
then Just idx
else find_acc tl needle (idx + 1)
else find_acc tl needle_ (idx + 1)
[] -> Nothing
in find_acc xs needle 0
......
......@@ -33,10 +33,10 @@ viewSwitcher : Model -> Html Msg
viewSwitcher model =
let
link : msg -> String -> Html msg
link msg text =
link msg msgtext =
Html.a
[ HA.href "javascript: ;", HE.onClick msg ]
[ Html.text text]
[ Html.text msgtext]
in
Html.span
[ HA.class "multiLangSwitcher"
......
......@@ -75,8 +75,8 @@ last l =
fromList : List a -> Maybe (NonEmptyList a)
fromList =
let
onElement a tail =
case tail of
onElement a atail =
case atail of
Nothing ->
Just (Nil a)
Just nel ->
......
......@@ -43,6 +43,9 @@ type Msg
| StickToBottom Bool
| Screenshot
{-| added for elm 0.19 migration -}
uncurry f (a,b) = f a b
init : (Model, RPCmd.Command)
init =
let
......
......@@ -171,11 +171,11 @@ parseTraceLine line =
parseTrace : String -> Result String (List TraceLine)
parseTrace buf =
Regex.split Regex.All (regex "\n") buf
|> List.indexedMap (,) -- annotate with line numbers
|> List.indexedMap Tuple.pair -- annotate with line numbers
|> List.filter (lineHasRelevantInformation << Tuple.second) -- only keep relevant lines
|> List.map (\(i,l) ->
parseTraceLine l
|> Result.mapError ((++) ("Line " ++ toString i ++ ": "))
|> Result.mapError ((++) ("Line " ++ String.fromInt i ++ ": "))
)
|> LU.resultForAll
|> Result.mapError (String.concat << List.intersperse "\n")
......
......@@ -18,7 +18,7 @@ dot : Float -> P2D -> P2D
dot a p = { x = a * p.x, y = a * p.y }
showPoint : P2D -> String
showPoint p = (toString p.x) ++ "," ++ (toString p.y)
showPoint p = (String.fromFloat p.x) ++ "," ++ (String.fromFloat p.y)
determinant : P2D -> P2D -> Float
determinant a b = a.x * b.y - a.y * b.x
......
......@@ -16,6 +16,10 @@ type alias RailExample =
, rotation : Float -- the initial angle
}
{-| added for elm 0.19 migration -}
curry f a b = f (a,b)
toString = String.fromInt
flip f a b = f b a
type alias Query = List Int
......
......@@ -17,9 +17,10 @@ module RailPuzzle exposing
import Has exposing (Has)
import Has
import Time
import Time exposing (Time)
import Time exposing (Posix)
import Array
import Array exposing (Array)
import Browser.Events
import RailTree as RT
import RailTree exposing (RailTree)
import Carriage as C
......@@ -35,7 +36,6 @@ import Svg
import Svg.Events
import Svg.Lazy as Svg
import SvgUtils
import AnimationFrame
import TrackA
import Either
import RailPuzzle.Command as RPCmd
......@@ -46,6 +46,11 @@ import Char
import P2D
import Debug
{-| migration to 0.19 |-}
type alias TimeT = Time.Posix
flip f a b = f b a
uncurry f (a,b) = f a b
-- MODEL
type alias RawModel render_cache =
{ rt : RT.LayoutedRailTree (Has RT.Path ()) ()
......@@ -56,10 +61,11 @@ type alias RawModel render_cache =
-- the train to be built, refering to indices in the cars array
-- this does not need to mention all the cars
, query : List Int
-- a custom task list for Time.now-like tasks, but using AnimationFrame.times
-- a custom task list for Time.now-like tasks, but using
-- Browser.Events.onAnimationFrame (formerly AnimationFrame.times)
-- as a backend. This is because after a linux suspend, Time.now and
-- AnimationFrame.times seem to diverge.
, time_requested : List (Time -> Msg)
-- Browser.Events.onAnimationFrame (formerly AnimationFrame.times) seem to diverge.
, time_requested : List (TimeT -> Msg)
-- wether to show the cars in the desired order
, show_train_preview : Bool
, show_shunt_labels : Bool
......@@ -82,8 +88,8 @@ type Msg =
RailClicked RT.Path
| Undo
| CarIdxClicked Int
| CarMoveTime Int RT.Path Time -- same after having requested the time
| AnimationStep Time
| CarMoveTime Int RT.Path TimeT -- same after having requested the time
| AnimationStep TimeT
| Command RPCmd.Command
type alias Options = -- Some gui options
......@@ -103,8 +109,8 @@ init car_positions rail_net rotation =
let f = C.defaultFlags in
C.newCarAt
{ f
| label = toString (idx + 1)
, class = "car" ++ toString idx
| label = String.fromInt (idx + 1)
, class = "car" ++ String.fromInt idx
}
layouted_rail_net =
rail_net
......@@ -152,10 +158,10 @@ subscriptions m =
in
Sub.batch <| (
if car_moving || car_error
then AnimationFrame.times AnimationStep
then Browser.Events.onAnimationFrame AnimationStep
else Platform.Sub.none
) ::
List.map AnimationFrame.times m.time_requested
List.map Browser.Events.onAnimationFrame m.time_requested
carPositions : Model -> Array RT.Path
carPositions m = Array.map C.targetPlace m.cars
......@@ -186,8 +192,8 @@ finishAnimation model =
<| Array.map C.finishMotion
runCommandNoHistory : RPCmd.Command -> Model -> Model
runCommandNoHistory cmd model =
case cmd of
runCommandNoHistory cmd_ model =
case cmd_ of
RPCmd.ResetCars ->
resetCars model
......@@ -241,8 +247,8 @@ withoutHistory updater model =
runCommand : RPCmd.Command -> Model -> Model
runCommand cmd =
withHistory (runCommandNoHistory cmd)
runCommand cmd_ =
withHistory (runCommandNoHistory cmd_)
importHistory : History -> Model -> Model
importHistory hist model =
......@@ -278,7 +284,7 @@ conflicting_cars m idx old_path new_path =
Move the i'th car to a new position.
Marking the conflicting cars works only if a time is supplied.
-}
moveCarAnimated : Maybe Time -> Int -> RT.Path -> Model -> Model
moveCarAnimated : Maybe TimeT -> Int -> RT.Path -> Model -> Model
moveCarAnimated maybe_now idx path m =
case (Array.get idx m.cars |> Maybe.andThen C.restingPlace) of
Nothing -> m
......@@ -327,14 +333,14 @@ moveCarInstant idx new_path m =
update : Msg -> Model -> Model
update msg m =
case msg of
Command cmd ->
runCommand cmd m
Command cmd_ ->
runCommand cmd_ m
RailClicked path ->
runCommand (RPCmd.CarMove m.car_selected path) m
CarMoveTime idx path now ->
let
-- drop this CarMoveTime message from the time_requested-queue
is_not_this_msg : (Time -> Msg) -> Bool
is_not_this_msg : (TimeT -> Msg) -> Bool
is_not_this_msg time2msg = msg /= (time2msg now)
m_without_this_msg =
{ m | time_requested = List.filter is_not_this_msg m.time_requested }
......
......@@ -20,6 +20,11 @@ import P2D exposing (..)
import TrackA exposing (..)
{-| added for elm 0.19 migration -}
flip f a b = f b a
uncurry f (a,b) = f a b
toString = String.fromFloat
-- a tree of railways with
-- - tracks (of unit length) annotated by t
-- - junctions annotated by j
......@@ -32,7 +37,8 @@ isTrack rt =
Track t _ -> Just t
_ -> Nothing
type alias JunctionA = (Float,P2D,P2D, List(Float,P2D)) -- annotated junctions
{-| elm 0.19 only allows tuples of two or three, so we need to nest... |-}
type alias JunctionA = ((Float,P2D,P2D),List(Float,P2D)) -- annotated junctions
type alias LayoutedRailTree t j = RailTree (Has TrackA t) (Has JunctionA j)
......@@ -49,8 +55,8 @@ indexify : RailTree t j -> RailTree (Has Path t) j
indexify rt =
let
indexify_prefix : (Path -> Path) -> RailTree t j -> RailTree (Has Path t) j