CacheSim/src/CacheSim/View.elm

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

-- Button components, powered by Bootstrap
button : List (Attribute Msg) -> String -> Html Msg
button attrs s = input ([ type_ "button", value s, class "btn"] ++ attrs) []

basicButton : Msg -> String -> Html Msg
basicButton msg s = button [ onClick msg ] s

disabledButton : List (Attribute Msg) -> String -> Html Msg
disabledButton attrs = button (attrs ++ [ disabled True ])

dangerButton : String -> Msg -> Html Msg
dangerButton s m = button [ onClick m, class "btn-danger" ] s

infoButton : String -> Msg -> Html Msg
infoButton s m = button [ onClick m, class "btn-info" ] s

primaryButton : String -> Msg -> Html Msg
primaryButton s m = button [ onClick m, class "btn-primary" ] s

secondaryButton : String -> Msg -> Html Msg
secondaryButton s m = button [ onClick m, class "btn-secondary" ] s

maybeButton : Maybe a -> List (Attribute Msg) -> String -> (a -> Msg) -> Html Msg
maybeButton m attrs s f =
    case m of
        Just v -> button (attrs ++ [ onClick (f v) ]) s 
        _ -> disabledButton attrs s 

resultButton : Result e a -> List (Attribute Msg) -> String -> (a -> Msg) -> Html Msg
resultButton = maybeButton << Result.toMaybe

-- Button wrapper (button group)
buttonWrapper : List (Html Msg) -> Html Msg
buttonWrapper = div [ classList [("btn-group", True), ("mb-3", True), ("mr-3", True) ] ]

buttonToolbar : List (List (Html Msg)) -> Html Msg
buttonToolbar ll = div [ class "btn-toolbar" ] <| List.map buttonWrapper ll

-- Input with a label
labeledInput : String -> String -> (String -> Msg) -> Html Msg
labeledInput s val f =
    div [ class "input-group mb-3" ]
        [ div [ class "input-group-prepend" ]
            [ span [ class "input-group-text" ] [ text s ]
            ]
        , input [ value val, type_ "text", class "form-control", onInput f ] []
        ]

-- Error view
viewError : Bool -> String -> Html Msg
viewError hide e = div
    [ classList
        [ ("alert", True)
        , ("alert-danger", True)
        ]
    , hidden hide
    ] [ text e ]

panel : List (Html Msg) -> Html Msg
panel = div [ classList [("card", True), ("p-3", True), ("mb-3", True) ] ]

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 = dangerButton "Delete" (DeleteRawModel level)

        params = div []
            [ labeledInput "Block size (words)" rcm.blockSize (wrapUpdate updateBlockSize)
            , labeledInput "Set count" rcm.setCount (wrapUpdate updateSetCount)
            , labeledInput "Set size" rcm.setSize (wrapUpdate updateSetSize)
            ]
    in
        panel
            [ 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
        checkedResult =
            case translationResult of
                Ok h -> if h == [] then Err "Please specify at least one cache level." else Ok h
                Err e -> Err e
        errorHtml =
            case checkedResult of
                Ok _ -> viewError True ""
                Err e -> viewError False e
        
        newButton = infoButton "Add level" CreateRawModel
        useButton = resultButton checkedResult [ class "btn-info" ] "Start simulation" (UseHierarchy << Just) 
    in
        div []
            [ 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 = th [ 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 = [ th [ 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 * cm.blockSize * 4)) ++
                                "-" ++
                                (String.fromInt ((a + 1) * cm.blockSize * 4 - 1)) ]
            in
                List.map slotHtml set
        cacheRow = List.concat <| List.map setRow cs
        cacheTable =
            table [ class "table" ]
                [ tr [ hidden (cm.setCount == 1), class "table-info" ] setLabel
                , tr [ hidden (cm.setCount == 1) ] setLabels
                , tr [ hidden (cm.setSize == 1), class "table-info" ] allSlotsLabel
                , tr [ hidden (cm.setSize == 1) ] allSlotLabels
                , tr [] cacheRow
                ]

    in
        panel
            [ h3 [] [ text <| "L" ++ String.fromInt (level + 1) ++ " Cache" ]
            , cacheTable
            ]

viewCacheHierarchy : CacheHierarchy -> Html Msg
viewCacheHierarchy ch =
    let
        levels = div [] 
            <| List.indexedMap viewCache ch
    in
        levels
        
viewAccessView : Model -> AccessView -> Html Msg
viewAccessView m av =
    div []
        [ h2 [] [ text "Access Simulation" ]
        , p [] [ text ("Simulating access of address " ++ String.fromInt av.blockAddr) ]
        , buttonToolbar
            [ [ infoButton "Back" AccessViewBack, infoButton "Forward" AccessViewForward ]
            , [ dangerButton "Stop" AccessViewCancel ]
            ]
        , h3 [] [ text "Access event log" ]
        , viewAccessLog av
        , h3 [] [ text "Current cache state" ]
        , viewCacheHierarchy <| effectiveCacheHierarchy av
        ]   

viewAccessLog : AccessView -> Html Msg
viewAccessLog av =
    let
        resultSpan r =
            span [ classList [ ("badge", True), ("badge-success", r == Hit), ("badge-danger", r == Miss) ] ]
                [ text <| if r == Hit then "Hit" else "Miss" ]
        downEvent n ae = div [ class "event" ]
            [ text <| "L" ++ String.fromInt (n + 1) ++ " "
            , resultSpan ae.result
            ]
        upEvent n ae = div [ class "event" ]
            [ text <| "Updated L" ++ String.fromInt (List.length av.accessEffects - n)
            ]
        events = 
            case av.position of
                Preview -> List.indexedMap downEvent av.accessEffects ++
                    (List.indexedMap upEvent av.accessEffects) ++
                    [ div [ class "event" ] [ text "Access complete. Viewing final cache state." ] ]
                End -> []
                Down n -> List.indexedMap downEvent <| List.take (n + 1) av.accessEffects
                Up n -> List.indexedMap downEvent av.accessEffects ++
                    (List.indexedMap upEvent <| List.drop n av.accessEffects)
    in
        div [] events

viewAccessInput : Model -> Html Msg
viewAccessInput m =
    let
        parser =
            Parser.sequence
            { start = ""
            , end = ""
            , separator = ","
            , spaces = Parser.spaces
            , item = Parser.int
            , trailing = Parser.Optional
            }
        parseErrorToString _ = "Unable to parse input. Please enter a sequence of numbers separated by commas."
        parseResult = Parser.run (parser |. Parser.end) m.accessInput
        checkedResult =
            case parseResult of
                Ok is -> if is == [] then Err "Please enter at least one number." else Ok is
                Err e -> Err <| parseErrorToString e
        accessButton = resultButton checkedResult [ class "btn-info" ] "Access address" Access
        errorHtml =
            case checkedResult of
                Ok _ -> viewError True ""
                Err e -> viewError False e
        editHierarchyButton = button [ onClick (UseHierarchy Nothing), class "btn-dark" ] "Edit hierarchy"
    in
        div []
            [ h2 [] [ text "Run access simulation" ]
            , labeledInput "Access byte address" m.accessInput ChangeAccessInput
            , buttonWrapper [ accessButton, editHierarchyButton ]
            , errorHtml
            ]

viewDescription : Html Msg
viewDescription =
    div []
        [ h1 [] [ text "Cache simulator" ]
        , p []
            [ text <| "This is a simulator for testing various cache configurations for educational purposes. It allows for the creation of"
                ++ " n-way associative caches, and their special cases (direct mapped and fully associative caches)."
            ]
        , p []
            [ text <| "To use the simulator, first create a fitting cache configuration by using the \"Add level\" button,"
                ++ " as well as the settings provided by each individual cache level. When the cache is correctly specified, and"
                ++ " no warnings appear, click \"Start simulation\" to load the specified hierarchy and begin simulating. To simulate,"
                ++ " type a block address into the \"Access address\" field, and click \"Access\". This will bring forward the simulation"
                ++ " view, which will allow you to step through the steps of accessing a cache."
            ]
        ]

viewBase : Model -> Html Msg
viewBase m =
    let
        rawView = 
            case m.hierarchy of
                Nothing -> [ viewRawCacheModelHierarchy m.rawHierarchy ]
                Just _ -> []
        accessInputView =
            case (m.hierarchy, m.accessView) of
                (Just _, Nothing) -> [ viewAccessInput m ]
                _ -> []
        cacheView =
            case m.accessView of
                Nothing ->
                    Maybe.withDefault []
                        <| Maybe.map (List.singleton << viewCacheHierarchy) <| m.hierarchy
                Just _ -> []
        accessView = Maybe.withDefault [] <| Maybe.map (List.singleton << viewAccessView m) <| Maybe.andThen (List.head) <| m.accessView
        remainingAccessView =
            case Maybe.map (\l -> List.length l - 1) m.accessView of
                Just n -> if n <= 0 then [] else
                    [ div [ class "alert", class "alert-info" ] [ text <|
                        "Simulating more than one access. " ++ (String.fromInt n) ++
                        " addresses in queue." ]
                    ]
                _ -> []
    in
        div [ class "container" ]
            <| [ viewDescription] ++ rawView ++ accessInputView ++ remainingAccessView ++ accessView ++ cacheView