Interactive bracket validator using Elm

bracketInteract.elm

module Bracket where 

import Html exposing (..)
import Html.Events exposing (on, targetValue)
import Html.Attributes exposing (..)
import Signal exposing (Address)
import StartApp.Simple as StartApp
import String exposing (..)
import Dict exposing (..)
import List.Extra as Listx exposing (find)

-- import BingoUtils as Utils 

onInput : Address a -> (String -> a) -> Attribute
onInput address f =
  on "input" targetValue (\v -> Signal.message address (f v))



-- MODEL

type alias BPair = {
  opener: Char, 
  closer: Char,      -- corresponding closer
  isEnabled: Bool,   -- is the bracket pair enabled?
  id: Int
}

type alias BMap = List BPair

type alias Model =
  {
    expression: String, 
    stack: SStack,
    bmap: BMap
  }

-- Constructor function for creating new pairs 
newPair : Char -> Char -> BPair
newPair op cl =
  { opener = op,
    closer = cl,
    isEnabled = True,
    id = 0
  }


-- UPDATE 

type Action
  = NoOp
  | UpdateExpression String



update : Action -> Model -> Model
update action model =
  case action of
    NoOp ->
      model
  
    UpdateExpression contents ->
        { model | expression = contents }

---- Validator Related 

validate: Model -> Bool
validate model = 
  let 
    {expression, stack, bmap} = model 
  in 
    case (pop expression) of 
      Nothing -> 
        isEmpty stack

      Just (tok, restExpr) -> 
        case (getClosr tok bmap) of 
          Just (closer) -> 
            validate {model |
                        expression = restExpr,
                        stack = pushC closer stack } 
          Nothing -> 
            if (isClosr tok bmap) == True then
              case (pop stack) of 
                Just (ts, restOfStack) -> 
                  if ts == tok  then 
                    validate {model| 
                                expression = restExpr, 
                                stack = restOfStack }
                  else 
                    False 
                Nothing ->
                  False 
            else
              validate {model |expression = restExpr}

      
validateString: Model -> Bool 
validateString model  = 
  let 
    res = validate model  
    _= Debug.watch "Result " (res, s)
  in 
    res


type alias SStack = String

empty : SStack
empty =
  ""

push : String -> SStack -> SStack
push tok stacks = 
  tok ++ stacks


pop : SStack -> Maybe (Char, SStack)
pop stacks = 
  String.uncons stacks


peek: SStack -> String
peek stack = 
  String.slice 0 1 stack 


isEmpty: SStack -> Bool 
isEmpty s = 
  if String.isEmpty s then
    True
  else
    False 

pushC: Char -> SStack -> SStack
pushC c s = 
  push (String.fromChar c) s


isOpenr: Char -> List BPair -> Bool 
isOpenr o bmap = 
  List.member o (List.map .opener bmap)


isClosr: Char -> List BPair -> Bool 
isClosr c bmap = 
  List.member c (List.map .closer bmap)


matchEnabledOpenr: Char -> BPair -> Maybe Char
matchEnabledOpenr o bp = 
  if bp.isEnabled then
    if bp.opener == o then 
        Just(bp.closer)
    else 
        Nothing 
  else 
    Nothing

-- Four variants of the Closure function 
getClosr: Char -> List BPair -> Maybe Char 
getClosr o bm =  
  List.head (List.filterMap (matchEnabledOpenr o) bm )


getClosr2 : Char -> List BPair -> Maybe Char 
getClosr2 o bmap = 
  let 
    getPair {opener, closer, isEnabled} = 
      case isEnabled of 
        True -> 
          (opener, closer)
        False ->
          ('\0', '\0')
  in 
    bmap 
      --|> List.filter .isEnabled 
      |> List.map getPair  
      |> Dict.fromList 
      |> Dict.get o
  --  |> Maybe.withDefault '0'


matchEnabledOpenrX : Char -> BPair -> Bool
matchEnabledOpenrX o bp = 
  bp.isEnabled && bp.opener == o 


getClosr3 : Char -> List BPair -> Maybe Char 
getClosr3 opener bmap = 
  bmap 
    |> Listx.find (matchEnabledOpenrX opener)
    |> Maybe.map .closer 

  
getClosr4 : Char -> List BPair -> Maybe Char 
getClosr4 o bmap = 
  bmap 
    |> List.filter (matchEnabledOpenrX o)
    |> List.map .opener
    |> List.head 
    


-- VIEW 
      
entryForm : Address Action -> Model -> Html
entryForm address model =
  div [ ]
    [ input
        [ type' "text",
          placeholder "{( () )}",
          value model.expression,
          name "phrase",
          autofocus True,
          onInput address UpdateExpression,
          strStyle
        ]
        [ ],
      --button [ class "change" ] [ text "Change" ],
      h2
        [ revStyle]
        [ text (model.expression ++ " is " ++ 
          toString (validateString model )) ]
    ]


view : Address Action -> Model -> Html
view address model =
  div [ id "container" ]
    [ pageHeader,
      entryForm address model,
      pageFooter
    ]


initialModel : Model
initialModel =
  { expression = "", 
    bmap = 
      [
        newPair '(' ')',
        newPair '{' '}' 
      ], 
    stack = empty 
  }


-- WIRE IT ALL TOGETHER!

main: Signal Html
main =
  StartApp.start
    { model = initialModel,
      view = view,
      update = update
    }


title : String -> Int -> Html
title message times =
  message ++ " "
    |> toUpper
    |> repeat times
    |> trimRight
    |> text

pageHeader : Html
pageHeader =
  h1 [ ] [ title "Validator" 1 ]


pageFooter : Html
pageFooter =
  footer [ ]
    [ a [ href "http://edu.kgisl.com" ]
        [ text "KGISL CampSite" ]
    ]


strStyle : Attribute
strStyle =
  style
    [ ("width", "100%")
    , ("height", "40px")
    , ("padding", "10px 0")
    , ("font-size", "2em")
    , ("text-align", "center")
    ]
    
revStyle : Attribute
revStyle =
  style
    [ ("width", "100%")
    , ("height", "40px")
    , ("padding", "10px 0")
    , ("font-size", "2em")
    , ("text-align", "center")
    , ("color", "red")
    ]

getClosr == getClosr4 (more or less)
getClosr2 uses a dictionary as an intermediary
getClosr3 uses List.Extra's find function.