implementation module DynamicEditor

import StdMisc, Data.Tuple, Text, Data.Maybe
from StdFunc import seq, flip
from Data.Tuple import appFst
import iTasks, iTasks.UI.Definition, iTasks.UI.Editor.Common, iTasks.UI.Editor.Modifiers
import qualified Data.Map as Map
from Data.Func import $
import Util
from Data.List import zip3, intersperse
import Data.Functor

:: DynamicCons =
    { consId           :: !DynamicConsId
    , label            :: !String
    , builder          :: !DynamicConsBuilder
    , showIfOnlyChoice :: !Bool
    }

(<<@@@) infixl 2 :: !DynamicCons !DynamicConsOption -> DynamicCons
(<<@@@) cons HideIfOnlyChoice = {cons & showIfOnlyChoice = False}

(@@@>>) infixr 2 :: !DynamicConsOption !DynamicCons -> DynamicCons
(@@@>>) opt cons = cons <<@@@ opt

functionCons :: !String !String !a -> DynamicCons | TC a
functionCons consId label func = functionConsDyn consId label (dynamic func)

functionConsDyn :: !String !String !Dynamic -> DynamicCons
functionConsDyn consId label func = { consId           = consId
                                    , label            = label
                                    , builder          = FunctionCons func
                                    , showIfOnlyChoice = True
                                    }

listCons :: !String !String !([a] -> b) -> DynamicCons | TC a & TC b
listCons consId label func = listConsDyn consId label (dynamic func)

listConsDyn :: !String !String !Dynamic -> DynamicCons
listConsDyn consId label func = { consId           = consId
                                , label            = label
                                , builder          = ListCons func
                                , showIfOnlyChoice = True
                                }

customEditorCons :: !String !String !(Editor a) -> DynamicCons | TC, JSONEncode{|*|}, JSONDecode{|*|}, gText{|*|} a
customEditorCons consId label editor = { consId           = consId
                                       , label            = label
                                       , builder          = CustomEditorCons editor
                                       , showIfOnlyChoice = True
                                       }

// TODO: don't use aborts here
toValue :: !(DynamicEditor a) !(DynamicEditorValue a) -> a | TC a
toValue (DynamicEditor dynEditor) (DynamicEditorValue cid val) = case toValue` (cid, val) of
    (v :: a^) = v
    _         = abort "corrupt dynamic editor value"
where
    toValue` :: !(!DynamicConsId, !DEVal) -> Dynamic
    toValue` (cid, val) = case val of
        DEApplication args = case cons.builder of
            FunctionCons fbuilder = toValueFunc fbuilder args
            ListCons     lbuilder = toValueList lbuilder args
            _                     = abort "corrupt dynamic editor value"
        DEJSONValue json = case cons.builder of
            CustomEditorCons editor = toValueGen editor json
            _                       = abort "corrupt dynamic editor value"
    where
        (cons, _) = consWithId cid dynEditor

    toValueFunc :: !Dynamic ![(!DynamicConsId, !DEVal)] -> Dynamic
    toValueFunc v [] = v
    toValueFunc f [x : xs] = case (f, toValue` x) of
        (f :: a -> b, x :: a) = toValueFunc (dynamic (f x)) xs
        _                     = abort "corrupt dynamic editor value"

    toValueGen :: (Editor a) !JSONNode -> Dynamic | JSONDecode{|*|}, TC a
    toValueGen editor json = dynamic (fromJSON` editor json)
    where
        fromJSON` :: (Editor a) !JSONNode -> a | JSONDecode{|*|} a
        fromJSON` _ json = fromMaybe (abort "corrupt dynamic editor value") $ fromJSON json

    toValueList :: !Dynamic ![(!DynamicConsId, !DEVal)] -> Dynamic
    toValueList (f :: [a] -> b) [] = dynamic (f [])
    toValueList f args=:[fst : _] = case (f, toValue` fst) of
        (g :: [a] -> b, _ :: a) -> dynamic (g $ fromDynList [toValue` val \\ val <- args])
        _                       -> abort "corrupt dynamic editor value"
    toValueList _ _ = abort "corrupt dynamic editor value"

    fromDynList :: ![Dynamic] -> [a] | TC a
    fromDynList dyns = fromDynList` dyns []
    where
        fromDynList` [] acc = reverse acc
        fromDynList` [(a :: a^) : dyns] acc = fromDynList` dyns [a:acc]
        fromDynList` _ _ = abort "corrupt dynamic editor value"

dynEditorValToString :: !(DynamicEditor a) !(DynamicEditorValue a) -> String
dynEditorValToString (DynamicEditor dynEditor) (DynamicEditorValue cid val) =
    concat $ reverse $ dynEditorValToString` (cid, val) []
where
    dynEditorValToString` :: !(!DynamicConsId, !DEVal) ![String] -> [String]
    dynEditorValToString` (cid, val) accum = case val of
        DEApplication args = case cons.builder of
            FunctionCons fbuilder = foldl (flip dynEditorValToString`)
                                             [" ", cons.DynamicCons.label : accum]
                                             args
            ListCons lbuilder
                # listElStrs = flatten $ intersperse [" ", cons.DynamicCons.label] $
                                                     (\arg -> dynEditorValToString` arg []) <$> reverse args
                = listElStrs ++ [" "] ++ accum
            _ = abort "corrupt dynamic editor value"
        DEJSONValue json = case cons.builder of
            CustomEditorCons editor = [ " ", toStringGen editor json
                                      , " ", cons.DynamicCons.label
                                      : accum
                                      ]
            _ = abort "corrupt dynamic editor value"
    where
        (cons, _) = consWithId cid dynEditor

    toStringGen :: (Editor a) !JSONNode -> String | gText{|*|}, JSONDecode{|*|}  a
    toStringGen editor json = toSingleLineText $ fromJSON` editor json
    where
        fromJSON` :: (Editor a) !JSONNode -> a | JSONDecode{|*|} a
        fromJSON` _ json = fromMaybe (abort "corrupt dynamic editor value") $ fromJSON json

derive class iTask DynamicEditorValue, DEVal

:: E = E.a: E (Editor (DynamicEditorValue a))
:: ConsType = Function | List | CustomEditor

derive JSONEncode ConsType
derive JSONDecode ConsType

dynamicEditor :: !(DynamicEditor a) -> Editor (DynamicEditorValue a) | TC a
dynamicEditor dynEditor=:(DynamicEditor conses)
    | duplicateIds = abort "duplicate cons IDs in dynamic editor"
    = compoundEditorToEditor
        {CompoundEditor| genUI = genUI, onEdit = onEdit, onRefresh = onRefresh, valueFromState = valueFromState}
where
    duplicateIds = hasDup $ (\b -> b.consId) <$> conses
    where
        // TODO: use hasDup from platform as soon as available
        hasDup :: ![a] -> Bool | Eq a
        hasDup []     = False
        hasDup [x:xs] = isMember x xs || hasDup xs

    genUI :: DataPath !(EditMode (DynamicEditorValue a)) !*VSt
          -> *(!MaybeErrorString (!UI, !Maybe (!DynamicConsId, !ConsType), ![EditState]), !*VSt)
    genUI dp mode vst=:{VSt|taskId} = case mode of
        Enter = case matchingConses of
            [onlyChoice] | hideCons
                # (mbUis, _, type, _, vst) = genChildEditors dp onlyChoice.consId Enter vst
                # mbUis = ( \(uis, childSts) -> (uiContainer uis, Just (onlyChoice.consId, type), [nullState: childSts])
                          ) <$>
                          mbUis
                = (mbUis, vst)
            _
                # (consChooseUI, chooseSt) = genConsChooseUI taskId dp Nothing
                = (Ok (uiContainer [consChooseUI], Nothing, [chooseSt]), vst)

        Update (DynamicEditorValue cid val)
            # (mbUis, idx, type, label, vst) = genChildEditors dp cid (Update val) vst
            = case mbUis of
                Ok (uis, childSts)
                    | hideCons
                        = (Ok (uiContainer uis, Just (cid, type), [nullState: childSts]), vst)
                    | otherwise
                        # (consChooseUI, chooseSt) = genConsChooseUI taskId dp (Just idx)
                        = (Ok (uiContainer [consChooseUI: uis], Just (cid, type), [chooseSt: childSts]), vst)
                Error e = (Error e, vst)

        View (DynamicEditorValue cid val)
            # (mbUis, _, type, label, vst) = genChildEditors dp cid (View val) vst
            = case mbUis of
                Ok (uis, childSts)
                    | hideCons
                        = (Ok (uiContainer uis, Just (cid, type), [nullState: childSts]), vst)
                    | otherwise
                        # consChooseUI = uia UITextView $ valueAttr $ JSONString label
                        = (Ok (uiContainer [consChooseUI: uis], Just (cid, type), [nullState: childSts]), vst)
                Error e = (Error e, vst)

    genConsChooseUI taskId dp mbSelectedCons = (consChooseUI, consChooseSt)
    where
        consOptions = [JSONObject [("id",JSONInt i),("text",JSONString cons.DynamicCons.label)] \\ cons <- matchingConses & i <- [0..]]
        consChooseUI = uia UIDropdown
                           ( 'Map'.put "width" JSONNull $
                             choiceAttrs taskId (editorId dp) (maybe [] (\x -> [x]) mbSelectedCons) consOptions
                           )
        consChooseSt = LeafState {touched=False,state=maybe JSONNull (\x -> JSONInt x) mbSelectedCons}

    onEdit :: !DataPath
              !(!DataPath, !JSONNode)
              !(Maybe (!DynamicConsId, !ConsType))
              ![EditState]
              !*VSt
           -> *( !MaybeErrorString (!UIChange, !Maybe (!DynamicConsId, !ConsType), ![EditState])
               , !*VSt
               )
    // new builder is selected: create a UI for the new builder
    onEdit dp ([], JSONArray [JSONInt builderIdx]) _ [_: childrenSts] vst
        | builderIdx < 0 || builderIdx >= length matchingConses
            = (Error "Dynamic editor selection out of bounds", vst)
        # cons = matchingConses !! builderIdx
        # (mbRes, _, type, _, vst) = genChildEditors dp cons.consId Enter vst
        = case mbRes of
            Ok (uis, childSts)
                // insert new UIs for arguments
                # inserts = [(i, InsertChild ui) \\ ui <- uis & i <- [1..]]
                # removals = removeNChildren $ length childrenSts
                # change = ChangeUI [] (removals ++ inserts)
                # builderChooseState = LeafState {touched = True, state = JSONInt $ length uis}
                = (Ok (change, Just (cons.consId, type), [builderChooseState: childSts]), vst)
            Error e = (Error e, vst)

    // other events targeted directly at this building cons
    onEdit dp ([],e) _ [_: childSts] vst
        | e =: JSONNull || e =: (JSONArray []) // A null or an empty array are accepted as a reset events
            //If necessary remove the fields of the previously selected cons
            # change = ChangeUI [] $ removeNChildren $ length childSts
            = (Ok (change, Nothing, [nullState: childSts]), vst)
        | otherwise
            = (Error $ concat ["Unknown dynamic editor select event: '", toString e, "'"], vst)

    // update is targeted somewhere inside this value    
    onEdit dp ([argIdx: tp], e) (Just (cid, type)) childSts vst
        # (cons, _) = consWithId cid matchingConses
        # (res, vst) = case cons.builder of
            FunctionCons fbuilder
                # children = childrenEditors fbuilder
                | argIdx < 0 || argIdx >= length children
                    = (Error "Edit event for dynamic editor has invalid path", vst)
                # (E editor) = children !! argIdx
                = editor.Editor.onEdit (dp ++ [argIdx]) (tp, e) (childSts !! (argIdx + 1)) vst
            ListCons lbuilder
                = (listBuilderEditor lbuilder).Editor.onEdit (dp ++ [0]) (tp, e) (childSts !! 1) vst
            CustomEditorCons editor
                = editor.Editor.onEdit (dp ++ [0]) (tp, e) (childSts !! 1) vst
        = case res of
            Ok (change, childSt)
                # change = ChangeUI [] [(argIdx + if hideCons 0 1, ChangeChild change)]
                // replace state for this child
                = (Ok (change, Just (cid, type), updateAt (argIdx + 1) childSt childSts), vst)
            Error e = (Error e, vst)

    onEdit _ _ _ _ vst = (Error "Invalid edit event for dynamic editor.", vst)

    removeNChildren :: !Int -> [(!Int, !UIChildChange)]
    removeNChildren nrArgs = repeatn nrArgs (1, RemoveChild)

    childrenEditors :: !Dynamic -> [E]
    childrenEditors (f :: a -> b) = [E $ dynamicEditorFstArg f : childrenEditors (dynamic (f undef))]
    where
        // first argument only used for type
        dynamicEditorFstArg :: (a -> b) -> Editor (DynamicEditorValue a) | TC a
        dynamicEditorFstArg _ = dynamicEditor $ DynamicEditor conses
    childrenEditors _         = []

    onRefresh :: !DataPath
                 !(DynamicEditorValue a)
                 !(Maybe (!DynamicConsId, !ConsType))
                 ![EditState]
                 !*VSt
              -> *( !MaybeErrorString ( !UIChange
                                      , !Maybe (!DynamicConsId, !ConsType)
                                      , ![EditState]
                                      )
                  , !*VSt
                  )
    onRefresh dp new mbCid childSts vst = (Error "dynamic editor: onRefresh not implemented!", vst)

    // TODO: accept ID or index
    genChildEditors :: !DataPath !DynamicConsId !(EditMode DEVal) !*VSt
                    -> *(!MaybeErrorString (![UI], ![EditState]), Int, ConsType, String, !*VSt)
    genChildEditors dp cid mode vst= case cons.builder of
        FunctionCons fbuilder
            # (mbUis, vst) = genChildEditors` (reverse $ zip3 vals (childrenEditors fbuilder) [0..]) [] [] vst
            = (mbUis, idx, type, cons.DynamicCons.label, vst)
        where
            genChildEditors` [] accUi accSt vst = (Ok (accUi, accSt), vst)
            genChildEditors` [(mbVal, E editor, i): children] accUi accSt vst =
                case editor.Editor.genUI (dp ++ [i]) (maybe Enter (if viewMode View Update) mbVal) vst of
                    (Ok (ui, st), vst) = genChildEditors` children [ui: accUi] [st: accSt] vst
                    (Error e,     vst) = (Error e, vst)

            vals :: [Maybe (DynamicEditorValue a)]
            vals = case editModeValue mode of
                // update or view mode
                Just (DEApplication children) = [Just $ DynamicEditorValue cid val \\ (cid, val) <- children]
                // enter mode
                _                             = repeat Nothing
        ListCons lbuilder
            # listEditorMode = mapEditMode (\(DEApplication listElems) -> listElems) mode
            # (mbUi, vst) = (listBuilderEditor lbuilder).Editor.genUI (dp ++ [0]) listEditorMode vst
            = ((\(ui, st) -> ([ui], [st])) <$> mbUi, idx, type, cons.DynamicCons.label, vst)
        CustomEditorCons editor
            # editorMode = mapEditMode
                (\(DEJSONValue json) -> fromMaybe (abort "Invalid dynamic editor state") $ fromJSON json)
                mode
            # (mbUi, vst) = editor.Editor.genUI (dp ++ [0]) editorMode vst
            = ((\(ui, st) -> ([ui], [st])) <$> mbUi, idx, type, cons.DynamicCons.label, vst)
    where
        (cons, idx) = consWithId cid matchingConses
        type = case cons.builder of
            FunctionCons     _ = Function
            ListCons         _ = List
            CustomEditorCons _ = CustomEditor
        viewMode = mode =: View _
 
    hideCons = case matchingConses of
        [onlyChoice] | not onlyChoice.showIfOnlyChoice = True
        _                                              = False

    matchingConses = catMaybes (matchingCons dynEditor <$> conses)

    // first arg only used for type
    // packs matching conses, with possibly updated (= more specific) type
    matchingCons :: !(DynamicEditor a) !DynamicCons -> Maybe DynamicCons | TC a
    matchingCons dynEd cons=:{builder} = (\b -> {cons & builder = b}) <$> mbBuilder`
    where
        mbBuilder` = case builder of
            FunctionCons     fbuilder = matchf fbuilder
            CustomEditorCons editor   = matchc editor
            ListCons         lbuilder = matchl lbuilder

        // works for functions with upto 10 args
        // the type of the dynamic is updated by unifying the function result with the type produced by the editor
        matchf :: !Dynamic -> Maybe DynamicConsBuilder
        matchf b = case (b, dynamic dynEd) of
            (b :: a b c d e f g h i j -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c d e f g h i   -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c d e f g h     -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c d e f g       -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c d e f         -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c d e           -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c d             -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b c               -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a b                 -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b :: a                   -> z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            (b ::                        z, _ :: DynamicEditor z) = Just $ FunctionCons (dynamic b)
            _                                                     = Nothing

        // custom editors do not allow for quantified variables, so no type update is required
        matchc e = case (dynamic e, dynamic dynEd) of
            (_ :: Editor a, _ :: DynamicEditor a) = Just $ CustomEditorCons e
            _                                     = Nothing

        matchl f = case (f, dynamic dynEd) of
            (f :: [a] -> b, _ :: DynamicEditor b) = Just $ ListCons (dynamic f)
            _                                     = Nothing

    listBuilderEditor :: !Dynamic -> Editor [(!DynamicConsId, !DEVal)]
    listBuilderEditor (lbuilder :: [a] -> b) = listEditor (Just $ const Nothing) True True Nothing childrenEd`
    where
        childrenEd  = childrenEditorList lbuilder
        childrenEd` = bijectEditorValue (\(cid, val)                   -> DynamicEditorValue cid val)
                                        (\(DynamicEditorValue cid val) -> (cid, val))
                                        childrenEd

        // first argument only used for type
        childrenEditorList :: ([a] -> b) -> Editor (DynamicEditorValue a) | TC a
        childrenEditorList _ = dynamicEditor $ DynamicEditor conses
    listBuilderEditor _ = abort "dynamic editors: invalid list builder value"

    uiContainer :: [UI] -> UI
    uiContainer uis  = UI UIContainer
                          ('Map'.fromList [("direction", JSONString "horizontal"), ("width", JSONString "wrap")])
                          uis

    valueFromState :: !(Maybe (!DynamicConsId, !ConsType)) ![EditState] -> *Maybe (DynamicEditorValue a)
    valueFromState (Just (cid, CustomEditor)) [_: [editorSt]] =
        mapMaybe (DynamicEditorValue cid o DEJSONValue o toJSON`) $ editor.Editor.valueFromState editorSt
    where
        ({builder}, _) = consWithId cid conses

        // toJSON` is used to solve overloading, JSONEncode{|*|} is attached to CustomEditorCons
        (editor, toJSON`) = case builder of
            CustomEditorCons editor = (editor, toJSON)
            _                       = abort "corrupt dynamic editor state"

    valueFromState (Just (cid, type)) [_: childSts] =
        mapMaybe (\childVals -> DynamicEditorValue cid $ DEApplication childVals) $ childValuesFor childSts` []
    where
        childSts` = case (type, childSts) of
            (List, [CompoundState _ childSts]) = childSts
            (_,    childSts)                   = childSts

        childValuesFor :: ![EditState] ![(!DynamicConsId, !DEVal)]
                       -> Maybe [(!DynamicConsId, !DEVal)]
        childValuesFor [] acc = Just $ reverse acc
        childValuesFor [childSt: childSts] acc = case (dynamicEditor dynEditor).Editor.valueFromState childSt of
            Just (DynamicEditorValue childCid childVal) = childValuesFor childSts [(childCid, childVal): acc]
            _                                           = Nothing
    valueFromState _ _ = Nothing

consWithId :: !DynamicConsId ![DynamicCons] -> (!DynamicCons, !Int)
consWithId cid conses = case filter (\({consId}, _) -> consId == cid) $ zip2 conses [0..] of
    [cons] = cons
    []     = abort $ "cons not found: " +++ cid
    _      = abort $ "duplicate conses: " +++ cid

nullState :: EditState
nullState = LeafState {touched = True, state = JSONNull}