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) ...@@ -4,6 +4,9 @@ import Array exposing (Array)
import List import List
import String 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, {-| A node in an array tree. For each child of some Node,
the parent index is the Node again. the parent index is the Node again.
-} -}
...@@ -35,11 +38,11 @@ reverseChildren = onChildren List.reverse ...@@ -35,11 +38,11 @@ reverseChildren = onChildren List.reverse
-} -}
fromArray : Array a -> (a -> Maybe Int) -> ArrayTree a fromArray : Array a -> (a -> Maybe Int) -> ArrayTree a
fromArray arr parent = fromArray arr parentfunc =
let let
-- withParents : Array (Node a) (with the a from above) -- withParents : Array (Node a) (with the a from above)
withParents = 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 x, b) -> Maybe (x,b)
hasFst (maybe_a, b) = Maybe.map (flip Tuple.pair b) maybe_a hasFst (maybe_a, b) = Maybe.map (flip Tuple.pair b) maybe_a
...@@ -52,7 +55,7 @@ fromArray arr parent = ...@@ -52,7 +55,7 @@ fromArray arr parent =
|> List.filterMap hasFst |> List.filterMap hasFst
in in
List.foldr List.foldr
(\(parent,child) -> Array.modify parent (prependChild child)) (\(parentnode,child) -> Array.modify parentnode (prependChild child))
withParents withParents
registerAtParents registerAtParents
...@@ -61,18 +64,22 @@ fromArray arr parent = ...@@ -61,18 +64,22 @@ fromArray arr parent =
toArray : ArrayTree a -> Array a toArray : ArrayTree a -> Array a
toArray = Array.map (.data) 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 : (a -> b) -> ArrayTree a -> ArrayTree b
map f arr = 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 : (Int -> a -> b) -> ArrayTree a -> ArrayTree b
indexedMap f arr = 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 : (Node a -> b) -> ArrayTree a -> ArrayTree b
mapNode f arr = 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 (..) ...@@ -10,13 +10,18 @@ import P2D exposing (..)
import Debug import Debug
import Has import Has
import Has exposing (Has) import Has exposing (Has)
import Time exposing (Time,inSeconds,second) import Time exposing (Posix,millisToPosix)
import String import String
import TrackA import TrackA
import TrackA exposing (TrackA) import TrackA exposing (TrackA)
import Either import Either
import Svg.Lazy as Svg 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 Direction = Upwards | Downwards
type alias MovingFlags = type alias MovingFlags =
...@@ -28,9 +33,9 @@ type alias MovingFlags = ...@@ -28,9 +33,9 @@ type alias MovingFlags =
-- lower point but also contains an -- lower point but also contains an
-- additional RT.Further for the lower_point -- additional RT.Further for the lower_point
, delta_len: Float -- the length of the path `delta` , delta_len: Float -- the length of the path `delta`
, start_time : Maybe Time -- when the motion started. , start_time : Maybe TimeT -- when the motion started.
, total_time : Time -- the duration of this motion , total_time : TimeT -- the duration of this motion
, time_passed : Time -- the time passed since `start_time` , time_passed : TimeT -- the time passed since `start_time`
} }
type CarriageMotion type CarriageMotion
...@@ -41,7 +46,7 @@ type alias CarriageFlags = ...@@ -41,7 +46,7 @@ type alias CarriageFlags =
{ selected : Bool { selected : Bool
, label : String , label : String
, class : String , class : String
, error_until : Maybe Time , error_until : Maybe TimeT
} }
type alias Carriage = type alias Carriage =
{ flags : CarriageFlags { flags : CarriageFlags
...@@ -63,32 +68,32 @@ hasError car = ...@@ -63,32 +68,32 @@ hasError car =
{-| {-|
activate the error field using the current time activate the error field using the current time
-} -}
setError_ : Time -> CarriageFlags -> CarriageFlags setError_ : Time.Posix -> CarriageFlags -> CarriageFlags
setError_ now flags = setError_ now flags =
-- mark the car as errornous for the next 2 seconds -- 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 = setError now car =
{ car | flags = setError_ now car.flags } { car | flags = setError_ now car.flags }
{-| Clear the error field if the time has progressed enough {-| Clear the error field if the time has progressed enough
-} -}
clearError_ : Time -> CarriageFlags -> CarriageFlags clearError_ : Time.Posix -> CarriageFlags -> CarriageFlags
clearError_ now flags = clearError_ now flags =
{ flags { flags
| error_until = | error_until =
case flags.error_until of case flags.error_until of
Just time -> Just time ->
if time <= now then Nothing else Just time if time <= (Time.posixToMillis now) then Nothing else Just time
Nothing -> Nothing Nothing -> Nothing
} }
clearError : Time -> Carriage -> Carriage clearError : Time.Posix -> Carriage -> Carriage
clearError now car = clearError now car =
case car.flags.error_until of case car.flags.error_until of
Just time -> Just time ->
if time <= now if time <= (Time.posixToMillis now)
then { car | flags = clearError_ now car.flags } then { car | flags = clearError_ now car.flags }
else car else car
Nothing -> Nothing ->
...@@ -158,7 +163,7 @@ carriageOffset car = ...@@ -158,7 +163,7 @@ carriageOffset car =
max 0.0 <| min 1.0 <| max 0.0 <| min 1.0 <|
if car.total_time <= 0 if car.total_time <= 0
then 1.0 then 1.0
else car.time_passed / car.total_time else (toFloat car.time_passed) / (toFloat car.total_time)
in in
(1.0 - ratio) * car.start_offset + ratio * car.final_offset (1.0 - ratio) * car.start_offset + ratio * car.final_offset
...@@ -219,11 +224,11 @@ renderAxis (angle,center) = ...@@ -219,11 +224,11 @@ renderAxis (angle,center) =
width = carConfig.axisLen width = carConfig.axisLen
r = carConfig.bumperRadius r = carConfig.bumperRadius
transform = transform =
"rotate(" "rotate("
++ (toString angle) ++ (toString angle)
++ "," ++ (toString center.x) ++ "," ++ (toString center.x)
++ "," ++ (toString center.y) ++ "," ++ (toString center.y)
++ ")" ++ ")"
in in
Svg.g Svg.g
[ SvgAttr.transform transform [ SvgAttr.transform transform
...@@ -259,11 +264,11 @@ renderCarriageOnPath offset path attributes car = ...@@ -259,11 +264,11 @@ renderCarriageOnPath offset path attributes car =
, carConfig.axis2_offset + offset , carConfig.axis2_offset + offset
) )
offset2point offset = offset2point offset_ =
RT.queryDistanceDown path offset RT.queryDistanceDown path offset_
|> Maybe.andThen (\(track,offs) -> |> Maybe.andThen (\(track,offs) ->
TrackA.trackWalkDistance track ( TrackA.trackWalkDistance track (
--(if car.flags.selected then Debug.log "offset" else identity) --(if car.flags.selected then Debug.log "offset_" else identity)
offs offs
) )
|> Either.justRight |> Either.justRight
...@@ -285,8 +290,8 @@ renderCarriage rt attributes car = ...@@ -285,8 +290,8 @@ renderCarriage rt attributes car =
--(\_ -> []) (Debug.log "Error: invalid car path" place) --(\_ -> []) (Debug.log "Error: invalid car path" place)
[] []
Just place -> Just place_ ->
case place of case place_ of
(RT.Track ta _) -> (RT.Track ta _) ->
let let
track = Has.witness ta track = Has.witness ta
...@@ -299,11 +304,12 @@ renderCarriage rt attributes car = ...@@ -299,11 +304,12 @@ renderCarriage rt attributes car =
Moving m -> Moving m ->
renderCarriageOnPath (carriageOffset m) m.delta attributes car renderCarriageOnPath (carriageOffset m) m.delta attributes car
animationStep : RT.LayoutedRailTree t j -> Time -> Carriage -> Carriage animationStep : RT.LayoutedRailTree t j -> Time.Posix -> Carriage -> Carriage
animationStep rt now car = animationStep rt now_posix car =
case car.motion of case car.motion of
(Moving m) -> (Moving m) ->
let let
now = Time.posixToMillis now_posix
start_time = Maybe.withDefault now m.start_time start_time = Maybe.withDefault now m.start_time
time_passed = (now - start_time) time_passed = (now - start_time)
in in
...@@ -357,71 +363,71 @@ sendCarriageToSafe arg = ...@@ -357,71 +363,71 @@ sendCarriageToSafe arg =
, delta_len = delta_len , delta_len = delta_len
, start_time = Nothing , start_time = Nothing
, time_passed = 0 , time_passed = 0
, total_time = Time.second * (delta_len / carConfig.speed) , total_time = round (time_second * (delta_len / carConfig.speed))
} }
) )
Nothing -> Nothing ->
case (List.unprefix arg.restingpath arg.new_path) of case (List.unprefix arg.restingpath arg.new_path) of
Nothing -> Nothing ->
Nothing Nothing
Just [] -> Just [] ->
Nothing Nothing
Just delta -> Just delta ->
RT.verifyPathToTrack importer arg.targetplace delta RT.verifyPathToTrack importer arg.targetplace delta
|> Maybe.andThen (\(verified_delta,_) -> |> Maybe.andThen (\(verified_delta,_) ->
let let
delta_len = delta_len =
RT.pathLength verified_delta RT.pathLength verified_delta
- 0.5 * restingtrack_len - 0.5 * restingtrack_len
- 0.5 * targettrack_len - 0.5 * targettrack_len
in in
-- Moving downwards -- Moving downwards
Just -- << Debug.log "new upwards motion" Just -- << Debug.log "new upwards motion"
<| Moving <| Moving
{ upper_point = arg.new_path { upper_point = arg.new_path
, final_point = arg.new_path , final_point = arg.new_path
, delta = verified_delta , delta = verified_delta
, start_offset = 0.5 * targettrack_len + delta_len , start_offset = 0.5 * targettrack_len + delta_len
, final_offset = 0.5 * targettrack_len , final_offset = 0.5 * targettrack_len
, delta_len = delta_len , delta_len = delta_len
, start_time = Nothing , start_time = Nothing
, time_passed = 0 , time_passed = 0
, total_time = Time.second * (delta_len / carConfig.speed) , total_time = round (time_second * (delta_len / carConfig.speed))
} }
) )
sendCarriageTo : RT.LayoutedRailTree t j -> RT.Path -> Carriage -> Carriage sendCarriageTo : RT.LayoutedRailTree t j -> RT.Path -> Carriage -> Carriage
sendCarriageTo rt new_path car = sendCarriageTo rt new_path car =
case car.motion of case car.motion of
(Moving _) -> car (Moving _) -> car
Resting restingpath -> Resting restingpath ->
let let
-- run all the partial functions -- run all the partial functions
--restingplace : Maybe (RT.LayoutedRailTree t j) --restingplace : Maybe (RT.LayoutedRailTree t j)
restingplace = RT.query rt restingpath restingplace = RT.query rt restingpath
--targetplace : Maybe (RT.LayoutedRailTree t j) --targetplace : Maybe (RT.LayoutedRailTree t j)
targetplace = RT.query rt new_path targetplace = RT.query rt new_path
restingtrack = restingtrack =
restingplace restingplace
|> Maybe.andThen RT.isTrack |> Maybe.andThen RT.isTrack
|> Maybe.map Has.witness |> Maybe.map Has.witness
targettrack = targettrack =
targetplace targetplace
|> Maybe.andThen RT.isTrack |> Maybe.andThen RT.isTrack
|> Maybe.map Has.witness |> Maybe.map Has.witness
in in
case (restingplace,targetplace,restingtrack,targettrack) of case ((restingplace,targetplace),restingtrack,targettrack) of
-- in case all previous partial functions succeeded -- in case all previous partial functions succeeded
(Just restingplace,Just targetplace,Just restingtrack,Just targettrack) -> ((Just restingplace_,Just targetplace_),Just restingtrack_,Just targettrack_) ->
-- pass them to the 'safe' variant -- pass them to the 'safe' variant
let let
motion = Maybe.withDefault car.motion <| sendCarriageToSafe motion = Maybe.withDefault car.motion <| sendCarriageToSafe
{ new_path=new_path { new_path=new_path
, restingpath =restingpath , restingplace =restingplace , targetplace=targetplace , restingpath =restingpath , restingplace =restingplace_ , targetplace=targetplace_
, restingtrack= restingtrack , targettrack=targettrack , restingtrack= restingtrack_ , targettrack=targettrack_
} }
in { car | motion = motion } in { car | motion = motion }
_ -> car _ -> car
sendCarriageToInstant : RT.LayoutedRailTree t j -> RT.Path -> Carriage -> Carriage sendCarriageToInstant : RT.LayoutedRailTree t j -> RT.Path -> Carriage -> Carriage
sendCarriageToInstant rt path car = finishMotion <| sendCarriageTo rt path car sendCarriageToInstant rt path car = finishMotion <| sendCarriageTo rt path car
......
...@@ -14,6 +14,9 @@ module Has exposing ...@@ -14,6 +14,9 @@ module Has exposing
type Has a b = type Has a b =
HasContainer 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 : b -> a -> Has a b
now_has = flip HasContainer now_has = flip HasContainer
......
...@@ -8,7 +8,7 @@ import Tuple ...@@ -8,7 +8,7 @@ import Tuple
unprefix : List a -> List a -> Maybe (List a) unprefix : List a -> List a -> Maybe (List a)
unprefix long short = unprefix long short =
case (long,short) of case (long,short) of
(long,[]) -> Just long (longplain,[]) -> Just longplain
(head_l::tail_l,head_s::tail_s) -> (head_l::tail_l,head_s::tail_s) ->
if head_l == head_s then if head_l == head_s then
unprefix tail_l tail_s unprefix tail_l tail_s
...@@ -62,6 +62,8 @@ isSorted le list = ...@@ -62,6 +62,8 @@ isSorted le list =
then isSorted le (a2::tail) then isSorted le (a2::tail)
else False 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 {-| for a list with updated elements, return its index, the old and the new
value for each updated element value for each updated element
...@@ -79,11 +81,14 @@ differentValue xs ys = ...@@ -79,11 +81,14 @@ differentValue xs ys =
{-| Range of integers, including the limits {-| Range of integers, including the limits
-} -}
range : Int -> Int -> List Int range : Int -> Int -> List Int
range a b = range = List.range
if a <= b -- range a b =
then List.scanl (+) a <| List.repeat (b-a) 1 -- if a <= b
else [] -- 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. {-| 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 [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 ...@@ -151,12 +156,12 @@ product la lb = List.concatMap (\a -> List.map (Tuple.pair a) lb) la
find : List a -> a -> Maybe Int find : List a -> a -> Maybe Int
find xs needle = find xs needle =
let let
find_acc xs needle idx = find_acc xs_ needle_ idx =
case xs of case xs_ of
(hd::tl) -> (hd::tl) ->
if (hd == needle) if (hd == needle_)
then Just idx then Just idx
else find_acc tl needle (idx + 1) else find_acc tl needle_ (idx + 1)
[] -> Nothing [] -> Nothing
in find_acc xs needle 0 in find_acc xs needle 0
......
...@@ -33,10 +33,10 @@ viewSwitcher : Model -> Html Msg ...@@ -33,10 +33,10 @@ viewSwitcher : Model -> Html Msg
viewSwitcher model = viewSwitcher model =
let let
link : msg -> String -> Html msg link : msg -> String -> Html msg
link msg text = link msg msgtext =
Html.a Html.a
[ HA.href "javascript: ;", HE.onClick msg ] [ HA.href "javascript: ;", HE.onClick msg ]
[ Html.text text] [ Html.text msgtext]
in in
Html.span Html.span
[ HA.class "multiLangSwitcher" [ HA.class "multiLangSwitcher"
......
...@@ -75,8 +75,8 @@ last l = ...@@ -75,8 +75,8 @@ last l =
fromList : List a -> Maybe (NonEmptyList a) fromList : List a -> Maybe (NonEmptyList a)
fromList = fromList =
let let
onElement a tail = onElement a atail =
case tail of case atail of
Nothing -> Nothing ->
Just (Nil a) Just (Nil a)
Just nel -> Just nel ->
......
...@@ -43,6 +43,9 @@ type Msg ...@@ -43,6 +43,9 @@ type Msg
| StickToBottom Bool | StickToBottom Bool
| Screenshot | Screenshot
{-| added for elm 0.19 migration -}
uncurry f (a,b) = f a b
init : (Model, RPCmd.Command) init : (Model, RPCmd.Command)
init = init =
let let
......
...@@ -171,11 +171,11 @@ parseTraceLine line = ...@@ -171,11 +171,11 @@ parseTraceLine line =
parseTrace : String -> Result String (List TraceLine) parseTrace : String -> Result String (List TraceLine)
parseTrace buf = parseTrace buf =
Regex.split Regex.All (regex "\n") 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.filter (lineHasRelevantInformation << Tuple.second) -- only keep relevant lines
|> List.map (\(i,l) -> |> List.map (\(i,l) ->
parseTraceLine l parseTraceLine l
|> Result.mapError ((++) ("Line " ++ toString i ++ ": ")) |> Result.mapError ((++) ("Line " ++ String.fromInt i ++ ": "))
) )
|> LU.resultForAll |> LU.resultForAll
|> Result.mapError (String.concat << List.intersperse "\n") |> Result.mapError (String.concat << List.intersperse "\n")
......
...@@ -18,7 +18,7 @@ dot : Float -> P2D -> P2D ...@@ -18,7 +18,7 @@ dot : Float -> P2D -> P2D
dot a p = { x = a * p.x, y = a * p.y } dot a p = { x = a * p.x, y = a * p.y }
showPoint : P2D -> String 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 : P2D -> P2D -> Float
determinant a b = a.x * b.y - a.y * b.x determinant a b = a.x * b.y - a.y * b.x
......
...@@ -16,6 +16,10 @@ type alias RailExample = ...@@ -16,6 +16,10 @@ type alias RailExample =
, rotation : Float -- the initial angle , 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