CacheSim/src/CacheSim/View.elm

264 lines
9.9 KiB
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
basicButton : List (Attribute Msg) -> String -> Html Msg
basicButton attrs s = input ([ type_ "button", value s, class "btn", class "btn-info" ] ++ attrs) []
disabledButton : String -> Html Msg
disabledButton = basicButton [ disabled True ]
advancedButton : List (Attribute Msg) -> String -> Msg -> Html Msg
advancedButton attrs s m = basicButton (attrs ++ [ onClick m ]) s
button : String -> Msg -> Html Msg
button s m = basicButton [ onClick m ] s
dangerButton : String -> Msg -> Html Msg
dangerButton = advancedButton [ class "btn-danger" ]
primaryButton : String -> Msg -> Html Msg
primaryButton = advancedButton [ class "btn-primary" ]
secondaryButton : String -> Msg -> Html Msg
secondaryButton = advancedButton [ class "btn-secondary" ]
maybeButton : Maybe a -> String -> (a -> Msg) -> Html Msg
maybeButton m s f =
case m of
Just v -> button s (f v)
_ -> disabledButton s
resultButton : Result e a -> 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) ] ]
-- 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" 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
errorHtml =
case translationResult of
Ok _ -> viewError True ""
Err e -> viewError False e
newButton = button "Add level" CreateRawModel
useButton = resultButton translationResult "Use hierarchy" (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 ]
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 =
let
currentCache = Maybe.withDefault [] m.hierarchy
in
div []
[ h2 [] [ text "Access Simulation" ]
, buttonWrapper
[ primaryButton "Back" AccessViewBack
, primaryButton "Forward" AccessViewForward
]
, h3 [] [ text "Access event log" ]
, viewAccessLog av
, h3 [] [ text "Current cache state" ]
, viewCacheHierarchy <| effectiveCacheHierarchy currentCache av
]
viewAccessLog : AccessView -> Html Msg
viewAccessLog (aes, ap) =
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 aes - n)
]
events =
case ap of
Done -> []
Down n -> List.indexedMap downEvent <| List.take (n + 1) aes
Up n -> List.indexedMap downEvent aes ++
(List.indexedMap upEvent <| List.drop n aes)
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
}
parseResult = Parser.run (parser |. Parser.end) m.accessInput
accessButton = maybeButton (Result.toMaybe parseResult) "Access address" Access
errorHtml =
case parseResult of
Ok _ -> viewError True ""
Err lde -> viewError False "Unable to parse input. Please enter a sequence of numbers separated by commas."
editHierarchyButton = button "Edit hierarchy" (UseHierarchy Nothing)
in
div []
[ h2 [] [ text "Run access simulation" ]
, labeledInput "Access 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 \"Use hierarchy\" 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
in
div [ class "container" ]
<| [ viewDescription] ++ rawView ++ accessInputView ++ accessView ++ cacheView