CacheSim/src/CacheSim/View.elm

module CacheSim.View exposing (..)
import CacheSim.Raw exposing (..)
import CacheSim.Model exposing (..)
import CacheSim.Cache exposing (..)
import CacheSim.Hierarchy exposing (..)
import Html exposing (Html, input, text, div, label, span, h2, h3, table, tr, td)
import Html.Attributes exposing (type_, class, value, for, classList, disabled, colspan)
import Html.Events exposing (onInput, onClick)

optionalButton : Bool -> String -> Msg -> Html Msg
optionalButton e s m =
    let
        events = if e then [ onClick m ] else  [ disabled (not e) ]
    in
        input ([ type_ "button", value s ] ++ events) []

button : String -> Msg -> Html Msg
button s m = input [ type_ "button", onClick m, value s] []

buttonWrapper : List (Html Msg) -> Html Msg
buttonWrapper = div [ class "button-wrapper" ]

labeledInput : String -> String -> (String -> Msg) -> Html Msg
labeledInput s val f =
    div [ class "input-group" ]
        [ span [] [ text s ]
        , input [ value val, type_ "text", onInput f ] []
        ]

viewRawCacheModel : Int -> RawCacheModel -> Html Msg
viewRawCacheModel level rcm =
    let
        updateBlockSize s cm = { cm | blockSize = s}
        updateSetCount s cm = { cm | setCount = s}
        updateSetSize s cm = { cm | setSize = s}
        wrapUpdate f s = ChangeRawModel level (f s)

        deleteButton = button "Delete" (DeleteRawModel level)

        params = div [ class "cache-model-params" ]
            [ labeledInput "Block size" rcm.blockSize (wrapUpdate updateBlockSize)
            , labeledInput "Set count" rcm.setCount (wrapUpdate updateSetCount)
            , labeledInput "Set size" rcm.setSize (wrapUpdate updateSetSize)
            ]
    in
        div [ class "cache-model" ]
            [ h3 [] [ text <| "L" ++ String.fromInt (level + 1) ++ " Cache" ]
            , buttonWrapper [ deleteButton ]
            , params
            ]

viewRawCacheModelHierarchy : RawCacheModelHierarchy -> Html Msg
viewRawCacheModelHierarchy rcmh =
    let
        models = div [ class "cache-model-levels" ] 
            <| List.indexedMap viewRawCacheModel rcmh
        translationResult = Result.andThen validateCacheModelHierarchy
            <| translateRawCacheModelHierarchy rcmh
        isValid =
            case translationResult of
                Ok _ -> True
                Err _ -> False
        errorHtml =
            case translationResult of
                Ok _ -> viewError True ""
                Err e -> viewError False e
        
        newButton = button "Add level" CreateRawModel
        useButton = case translationResult of
            Ok cmh -> optionalButton True "Use hierarchy" (UseHierarchy <| Just cmh)
            Err _ -> optionalButton False "Use hierarchy" (UseHierarchy Nothing)
    in
        div [ class "cache-model-hierarchy" ]
            [ h2 [] [ text "Cache hierarchy" ]
            , errorHtml
            , buttonWrapper [ newButton, useButton ]
            , models
            ]

viewCache : Int -> Cache -> Html Msg
viewCache level (cm, cs) =
    let
        slotLabels =
            List.indexedMap (\i _ -> td [] [ text <| String.fromInt i ])
            <| List.repeat cm.setSize ()
        slotLabel = td [ colspan cm.setSize ] [ text "Slot" ]
        allSlotLabels = List.concat <| List.repeat cm.setCount slotLabels
        allSlotsLabel = List.repeat cm.setCount slotLabel

        setLabels =
            List.indexedMap (\i _ -> td [ colspan cm.setSize ] [ text <| String.fromInt i ])
            <| List.repeat cm.setCount ()
        setLabel = [ td [ colspan <| cm.setSize * cm.setCount ] [ text "Set" ] ]
        setRow set =
            let
                slotHtml s =
                    case s of
                        Empty -> td [] [ text "" ]
                        Used l a -> td [] [ text <| String.fromInt a ]
            in
                List.map slotHtml set
        cacheRow = List.concat <| List.map setRow cs
        cacheTable =
            table []
                [ tr [ classList [("hidden", cm.setCount == 1)] ] setLabel
                , tr [ classList [("hidden", cm.setCount == 1)] ] setLabels
                , tr [ classList [("hidden", cm.setSize == 1)] ] allSlotsLabel
                , tr [ classList [("hidden", cm.setSize == 1)] ] allSlotLabels
                , tr [] cacheRow
                ]

    in
        div [ class "cache" ]
            [ h3 [] [ text <| "L" ++ String.fromInt level ++ " Cache" ]
            , cacheTable
            ]

viewCacheHierarchy : CacheHierarchy -> Html Msg
viewCacheHierarchy ch =
    let
        levels = div [ class "cache-levels" ] 
            <| List.indexedMap viewCache ch
    in
    div [ class "cache-hierarchy" ] <|
        [ h2 [] [ text <| "Cache hierarchy" ]
        , levels
        ]
        

viewError : Bool -> String -> Html Msg
viewError hide e = span [ classList [ ("hidden", hide) ] ] [ text e ]

viewBase : Model -> Html Msg
viewBase m =
    let
        rawView = viewRawCacheModelHierarchy m.rawHierarchy
        cacheView = Maybe.withDefault [] <| Maybe.map (List.singleton << viewCacheHierarchy) <| m.hierarchy
    in
        div [] <| [ rawView ] ++ cacheView