Commit 83b2ed8a authored by Thorsten Wißmann's avatar Thorsten Wißmann 🐧
Browse files

Migrate two more files

parent 3b3a93bc
......@@ -14,12 +14,18 @@ import NonEmptyList exposing (NonEmptyList)
import NonEmptyList as NEL
import ListUtils as LU
import Regex
import Regex exposing (regex,Regex)
import Regex exposing (fromString,Regex)
import Html
import Html.Attributes as HA
import Shunt
import Shunt exposing (ShuntMovement)
{-| migration to elm 0.19 |-}
flip f a b = f b a
regex src =
Maybe.withDefault Regex.never <|
Regex.fromString src
type TraceLine
= Specification (List Int) Bool
| State String
......@@ -73,7 +79,7 @@ parseShuntMovement str =
_ ->
Result.Err <|
"Expected a string with 3 characters and not "
++ (toString <| List.length charlist) ++ "."
++ (String.fromInt <| List.length charlist) ++ "."
shuntMovementToString : ShuntMovement -> String
shuntMovementToString sm =
......@@ -99,7 +105,7 @@ parseCompileCarMovements rt cars command =
reg_submatches : Regex -> String -> Array (Maybe String)
reg_submatches reg str =
Regex.find (Regex.AtMost 1) reg str
Regex.findAtMost 1 reg str
|> List.head -- now we have (Maybe Match)
|> Maybe.map (.submatches) -- we're only interested in submatches
|> Maybe.withDefault [] -- drop the outer maybe
......@@ -134,10 +140,10 @@ try_spec line =
case (m <| Array.get 0 params, m <| Array.get 1 params) of
(Just query, Just str_res) ->
parseTrainOrder query
|> Result.andThen (\query ->
|> Result.andThen (\query_ ->
try_bool str_res
|> Result.andThen (\res ->
Result.Ok (Specification query res)))
Result.Ok (Specification query_ res)))
(_, _) ->
Result.Err ("Line does not match to " ++ spec_regex)
......@@ -170,7 +176,7 @@ parseTraceLine line =
parseTrace : String -> Result String (List TraceLine)
parseTrace buf =
Regex.split Regex.All (regex "\n") buf
Regex.split (regex "\n") buf
|> List.indexedMap Tuple.pair -- annotate with line numbers
|> List.filter (lineHasRelevantInformation << Tuple.second) -- only keep relevant lines
|> List.map (\(i,l) ->
......@@ -192,13 +198,13 @@ parseTrainOrder str =
let
assertion_regex = "[a-zA-Z]+[0-9]+ = ([0-9]+)"
assertions : List Regex.Match
assertions = Regex.find Regex.All (regex assertion_regex) str
assertions = Regex.find (regex assertion_regex) str
in
assertions
|> List.sortBy (.match) -- sort lexicographically by rail identifier
|> List.filterMap (List.head << .submatches) -- extract car numbers (i.e. the first submatch)
|> List.filterMap identity
|> List.map (String.toInt)
|> List.map (\s -> Result.fromMaybe ("invalid int '" ++ s ++ "'") (String.toInt s))
|> LU.resultForAll
|> Result.mapError (String.concat << List.intersperse ", ")
|> Result.map (LU.dropDuplicates)
......
......@@ -73,6 +73,25 @@ type alias RawModel render_cache =
, render_cache : render_cache
}
mapRawModel : (a -> b) -> RawModel a -> RawModel b
mapRawModel f m =
{ rt = m.rt
, cars = m.cars
, rotation = m.rotation
, initial_car_positions = m.initial_car_positions
, car_selected = m.car_selected
, query = m.query
, time_requested = m.time_requested
, show_train_preview = m.show_train_preview
, show_shunt_labels = m.show_shunt_labels
, history = m.history
, render_cache = f m.render_cache
}
setRenderCache : RawModel b -> a -> RawModel a
setRenderCache m a = mapRawModel (\_ -> a) m
type alias RenderingCache =
{ train_preview : (SvgUtils.BoundedSvg TrainPreview.EmptyType)
, shunt_labels : List (Svg.Svg TrainPreview.EmptyType)
......@@ -402,7 +421,7 @@ fillRenderCache model =
RT.renderRailTree TrainPreview.exfalso root_bumper
in
{ model | render_cache =
setRenderCache model
{ train_preview = TrainPreview.render model.cars model.query
, shunt_labels =
Shunt.shunts model.rt
......@@ -416,7 +435,7 @@ fillRenderCache model =
++ root_bumper_svg
, bbox_rail_tree =
SvgUtils.bboxUnion (RT.boundingBox model.rt) (RT.boundingBox root_bumper)
}}
}
render_car rt idx car =
-- let _ = Debug.log "Moving car with index" idx in
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment