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 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
        accessButton = maybeButton (String.toInt m.accessInput) "Access address" Access
        editHierarchyButton = button "Edit hierarchy" (UseHierarchy Nothing)
    in
        div []
            [ h2 [] [ text "Run access simulation" ]
            , labeledInput "Access address" m.accessInput ChangeAccessInput
            , buttonWrapper [ accessButton, editHierarchyButton ]
            ]

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) <| m.accessView
    in
        div [ class "container" ]
            <| [ viewDescription] ++ rawView ++ accessInputView ++ accessView ++ cacheView