ModelingWorkbench.elm

import Html exposing (..)
import Html.Events exposing (onInput, onClick)
import Html.Attributes exposing (value)
import Char
import Dict exposing (Dict)

import Parser exposing(Parser, (|.), (|=), succeed, oneOrMore, zeroOrMore, int, symbol, oneOf, lazy, ignore, run, keyword)

-- Prog entry point
main = Html.beginnerProgram { model = model, view = view, update = update }

-- Model
type Expression = Const Int | Sum Expression Expression | Variable String


type alias ModelExpression = {
  raw: String, -- user generated content
  expression: Maybe Expression, -- parser model
  error: Maybe Parser.Error -- parser error
}

type alias ModelVariables = {
  raw: String, -- user generated content
  expression: Maybe (Dict String Int), -- parser model
  error: Maybe Parser.Error -- parser error
}
type alias Model = {
  expression: ModelExpression,
  variables: ModelVariables
}

model: Model
model = {
  expression = { raw = "", expression = Nothing, error = Nothing },
  variables = { raw = "", expression = Nothing, error = Nothing } }

-- UPDATE

type Msg = Parse String | ParseAndFormat | ParseVariables String

update : Msg -> Model -> Model
update msg model =
  case msg of
      Parse string -> case (run expressionParser string) of
        Ok success -> { model | expression = {expression = Just success, error = Nothing, raw = string } }
        Err e -> { model | expression = { expression = Nothing, error = Just e, raw = string} }
      ParseAndFormat -> let expr_ = model.expression in let expr = { expr_ | raw = Maybe.withDefault expr_.raw (Maybe.map prettyPrint expr_.expression) }
        in { model | expression = expr }
      ParseVariables _ -> model -- TODO


-- VIEW

viewError: Maybe Parser.Error -> Html Msg
viewError err =
    case err of
      Nothing -> text ""
      Just e -> div [] [
        div [] [text "row: ", text (toString e.row)],
        div [] [text "col: ", text (toString e.col)],
        div [] [text "source: ", text e.source],
        div [] [text "problem: ", text (toString e.problem)],
        div [] [text "context: ", text (toString e.context)]
      ]

view: Model -> Html Msg
view model =
  div []
    [
      div [] [
        h1 [] [text "Expression"],
        div [] [textarea [onInput Parse, value model.expression.raw] [text model.expression.raw]],
        div [] [button [onClick ParseAndFormat] [text "Format"]]
      ],
      div [] [
        h1 [] [ text "Variables"],
        div [] [textarea [onInput ParseVariables, value model.variables.raw] [text model.variables.raw]]
      ],
      div [] [viewError model.expression.error],
      div [] [
        h1 [] [text "pretty print:"],
        text (Maybe.withDefault  "" (Maybe.map prettyPrint model.expression.expression))
      ],
      div [] [
        h1 [] [text "interpreter:"],
        text (Maybe.withDefault  "" (Maybe.map (\x -> toString (interpreter x Dict.empty)) model.expression.expression))
      ]
    ]

-- PARSER
spaces : Parser ()
spaces =
  ignore zeroOrMore (\c -> c == ' ' || c == '\n')

expressionParser : Parser Expression
expressionParser = succeed identity
  |= oneOf [constParser, sumParser,variableParser]

constParser : Parser Expression
constParser = succeed Const |= int

variableParser : Parser Expression
variableParser = succeed Variable
  |= Parser.keep oneOrMore Char.isLower

sumParser : Parser Expression
sumParser = succeed Sum
  |. spaces
  |. symbol "("
  |. spaces
  |= lazy (\_ -> oneOf [constParser, sumParser,variableParser])
  |. spaces
  |. symbol "+"
  |. spaces
  |= lazy (\_ -> oneOf [constParser, sumParser,variableParser])
  |. spaces
  |. symbol ")"
  |. spaces


-- PRETTY PRINTER
prettyPrint: Expression -> String
prettyPrint expression =
  case expression of
    Const a -> toString a
    Sum a b -> String.concat ["(", prettyPrint a, " + ", prettyPrint b, ")"]
    Variable x -> x

prettyPrintError: Parser.Error -> String
prettyPrintError err = String.concat ["row", toString err.row ]


interpreter: Expression -> Dict.Dict String Int -> Maybe Int
interpreter expression context = case expression of
  Const a -> Just a
  Sum a b -> Maybe.map2 (+) (interpreter a context) (interpreter b context)
  Variable x -> let val = Dict.get x context
    in case val of
      Nothing -> Nothing
      Just v -> Just v


-- MISC

{-

FIXME:

- split in 3 files, one for the modeling workbenck (with composition operators), one for each "language"

TODO:

- Trying to solve the expression problem
- Untangle what is part of the platform and what is part of the API/language model workbench ?
- Simplify and reduce operation (instead of interpreting, tries to reduce the expression to its simplest form e.g. 1 + a + 3 => a + 4)

IDEA:
Language workbench : Help conceiving language components
Integration workbench : Help assembling languages (composition operators ??)
(Live) Modeling workbench : Help using models to solve domains problem
 -}