TraceErr.elm

import Html exposing (text)
import String


main =
  text <| toString <| List.map showPlaces <| rewrite rules init


type Arrow
  = Left
  | Right


init =
  [ Just Right
  , Just Right
  , Just Right
  , Nothing
  , Just Left
  , Just Left
  , Just Left
  ]


isDone places =
  showPlaces places == "<<<.>>>"


rules places =
  List.concatMap
    ((|>) places) 
    [ jumpRight
    , jumpLeft
    , moveOneRight
    , moveOneLeft
    ]



jumpRight places =
  case places of
    Just Right :: Just x :: Nothing :: rest ->
      [Nothing :: Just x :: Just Right :: rest]
    _ ->
      []



jumpLeft places =
  case places of
    Nothing :: Just x :: Just Left :: rest ->
      [Just Left :: Just x :: Nothing :: rest]
    _ ->
      []



moveOneLeft places =
  case places of
    Nothing :: Just Left :: rest ->
      [Just Left :: Nothing :: rest]
    _ ->
      []


moveOneRight : Rewriter (List (Maybe Arrow))
moveOneRight places =
  case places of
    Just Right :: Nothing :: rest ->
      [Nothing :: Just Right :: rest]
    _ ->
      []


traceStep : List (Trace a) -> Rewriter a -> List (Trace a)
traceStep traces f =
  let
    splitTrace : Trace a -> List (Trace a)
    splitTrace trace =
      case trace of
        [] -> Debug.crash "cannot split empty trace"
        last :: previous ->
          f last |> List.map ((::) previous)
  in
    traces |> List.map splitTrace


type alias Trace a = List a
type alias Rewriter a = a -> List a


rewrite : Rewriter (List a) -> Rewriter (List a)
rewrite f places =
  let
    loop futures init tail =
      case tail of
        [] -> futures
        (head :: tail') ->
          let
            init' = init ++ [head]
            futures' =
              tail
              |> f
              |> List.map ((++) init)
              |> (++) futures
          in
            loop futures' (init ++ [head]) tail'
  in
    loop [] [] places


showPlaces =
  List.map showPlace >> String.concat


showPlace place =
  case place of
    Just Left -> "<"
    Just Right -> ">"
    Nothing -> "."