Work in progress

RaphaelGauthier · Aug 28, 2023 · 2f2311c · 2f2311c
1 parent 1a19341
commit 2f2311c
Show file tree

Hide file tree

Showing 9 changed files with 547 additions and 105 deletions.
diff --git a/webapp/sources/rudder/rudder-web/src/main/elm/sources/FileManager/Action.elm b/webapp/sources/rudder/rudder-web/src/main/elm/sources/FileManager/Action.elm
@@ -7,10 +7,14 @@ import Http exposing (Body, emptyBody, expectJson, header, request, stringBody)
 import Json.Decode.Pipeline exposing (required)
 import Json.Encode
 import List exposing ( map)
-import FileManager.Model exposing (..)
+import List.Extra
+
 import String exposing (dropLeft)
 import Url.Builder exposing (string, toQuery, QueryParameter)
 
+import FileManager.Model exposing (..)
+import FileManager.Util exposing (getDirPath)
+
 get :  String -> Decoder a -> (Result Http.Error a -> msg) -> Cmd msg
 get url decoder handler =
   request
@@ -47,19 +51,23 @@ upload api dir file =
     , tracker = Just "upload"
     }
 
-listDirectory : String -> String -> Cmd Msg
+listDirectory : String -> List String -> Cmd Msg
 listDirectory api dir =
   let
+    currentFolder = case List.Extra.last dir of
+      Just  d -> d
+      Nothing -> "/"
+
     body =  Json.Encode.object [
               ("action", Json.Encode.string "list")
-            , ("path", Json.Encode.string dir)
+            , ("path", Json.Encode.string (getDirPath dir))
             ]
   in
   post
     api
     (Http.jsonBody body )
     (Decode.at ["result"] (Decode.list fileDecoder))
-    (EnvMsg << LsGotten)
+    (EnvMsg << (LsGotten currentFolder))
 
 fileDecoder : Decode.Decoder FileMeta
 fileDecoder =

diff --git a/webapp/sources/rudder/rudder-web/src/main/elm/sources/FileManager/Env.elm b/webapp/sources/rudder/rudder-web/src/main/elm/sources/FileManager/Env.elm
@@ -1,22 +1,25 @@
 module FileManager.Env exposing (..)
 
-import FileManager.Action exposing (..)
 import Browser.Dom exposing (getElement)
 import List exposing (filter, indexedMap, map, member, reverse)
-import FileManager.Model exposing (..)
+import List.Extra exposing (takeWhile)
 import Platform.Cmd
-import FileManager.Port exposing (close)
 import String exposing (fromInt)
 import Task exposing (sequence)
 import Tuple exposing (first, second)
-import FileManager.Util exposing (..)
+import Dict exposing (Dict)
+
+import FileManager.Action exposing (..)
+import FileManager.Port exposing (close)
+import FileManager.Model exposing (..)
 import FileManager.Vec exposing (..)
+import FileManager.Util exposing (..)
 
 handleEnvMsg : EnvMsg -> Model -> (Model, Cmd Msg)
 handleEnvMsg msg model = case msg of
   Open () -> ({ model | open = True }, Cmd.none)
   Close -> ({ model | open = False, selected = [] }, close [])
-  Accept -> ({ model | open = False, selected = [] }, close <| reverse <| map ((++) model.dir << .name) model.selected)
+  Accept -> ({ model | open = False, selected = [] }, close <| reverse <| map ((++) (getDirPath model.dir) << .name) model.selected)
   MouseDown maybe pos1 ctrl ->
     ( { model
       | mouseDown = True
@@ -50,7 +53,7 @@ handleEnvMsg msg model = case msg of
         | mouseDown = False
         , drag = False
         , showContextMenu = case maybe of
-            Just file -> not <| model.dir == model.clipboardDir && member file model.clipboardFiles
+            Just file -> not <| (getDirPath model.dir) == model.clipboardDir && member file model.clipboardFiles
             Nothing -> True
         , selected = case maybe of
             Just _ -> model.selected
@@ -76,14 +79,50 @@ handleEnvMsg msg model = case msg of
         }
         , case maybe of
             Just file -> if model.drag && (file.type_ == "dir") && (not << member file) model.selected
-              then move model.api model.dir model.selected <| "/" ++ file.name ++ "/"
+              then move model.api (getDirPath model.dir) model.selected <| "/" ++ file.name ++ "/"
               else Cmd.none
             Nothing -> Cmd.none
-      )      
-  GetLs dir -> ({ model | dir = dir, files = [], load = True }, listDirectory model.api dir)
-  LsGotten result -> case result of
-    Ok files -> ({ model | files = files, selected = [], load = False }, Cmd.none)
+      )
+
+  GetLs dir ->
+    let
+      newDir = if List.member dir model.dir then takeWhile (\d -> d /= dir) model.dir else List.append model.dir [dir]
+    in
+      ({ model | dir = newDir, files = [], load = True }, listDirectory model.api newDir)
+
+  GetLsTree dir ->
+    ({ model | dir = dir, files = [], load = True }, listDirectory model.api dir)
+
+  LsGotten folder result -> case result of
+    Ok files ->
+      let
+        toItems : List FileMeta -> List String
+        toItems fs = fs
+          |> List.filter (\f -> f.type_ == "dir")
+          |> List.map .name
+          |> List.sort
+
+        childs = toItems files
+
+        newTree = case Dict.get folder model.tree of
+          Just ti -> Dict.insert folder (TreeItem folder ti.parents childs) model.tree
+          Nothing ->
+            let
+              values = Dict.values model.tree
+
+              parents = case List.Extra.find (\ti -> List.member folder ti.childs) values of
+                Just p  -> List.append [p.name] p.parents
+                Nothing -> []
+
+            in
+              Dict.insert folder (TreeItem folder parents childs) model.tree
+
+        filters = model.filters
+        newFilters = {filters | opened = folder :: filters.opened}
+      in
+        ({ model | files = files, selected = [], load = False, tree = newTree, filters = newFilters }, Cmd.none)
     Err _ -> (model, Cmd.none)
+
   Refresh result -> case result of
     Ok () -> (model, listDirectory model.api model.dir)
     Err _ -> (model, Cmd.none)

diff --git a/webapp/sources/rudder/rudder-web/src/main/elm/sources/FileManager/Model.elm b/webapp/sources/rudder/rudder-web/src/main/elm/sources/FileManager/Model.elm
@@ -4,6 +4,7 @@ import Browser.Dom exposing (Element)
 import File exposing (File)
 import Http exposing (Error)
 import FileManager.Vec exposing (..)
+import Dict exposing (Dict)
 
 type alias Flags =
   { api: String
@@ -13,11 +14,24 @@ type alias Flags =
   , hasWriteRights : Bool
   }
 
+type ViewMode = ListView | GridView
+
+type SortBy = FileName | FileSize | FileDate | FileRights
+
+type SortOrder = Asc | Desc
+
+type alias Filters =
+  { filter : String
+  , sortBy : SortBy
+  , sortOrder : SortOrder
+  , opened : List String
+  }
+
 type alias Model =
   { api: String
   , thumbnailsUrl: String
   , downloadsUrl: String
-  , dir: String
+  , dir: List String
   , open: Bool
   , load: Bool
   , pos1: Vec2
@@ -41,6 +55,15 @@ type alias Model =
   , clipboardFiles: List FileMeta
   , uploadQueue: List File
   , hasWriteRights: Bool
+  , viewMode : ViewMode
+  , filters  : Filters
+  , tree     : Dict String TreeItem
+  }
+
+type alias TreeItem =
+  { name    : String
+  , parents : List String
+  , childs  : List String
   }
 
 type alias FileMeta =
@@ -70,6 +93,8 @@ type Msg
   | Delete
   | UpdateApiPath String
   | None
+  | ChangeViewMode ViewMode
+  | UpdateFilters Filters
 
 type EnvMsg
   = Open ()
@@ -80,7 +105,8 @@ type EnvMsg
   | MouseMove Vec2
   | MouseUp (Maybe FileMeta) Int
   | GetLs String
-  | LsGotten (Result Error (List FileMeta)) 
+  | GetLsTree (List String)
+  | LsGotten String (Result Error (List FileMeta))
   | Refresh (Result Error ())
   | GotContent (Result Error String)
 

diff --git a/webapp/sources/rudder/rudder-web/src/main/elm/sources/FileManager/Update.elm b/webapp/sources/rudder/rudder-web/src/main/elm/sources/FileManager/Update.elm
@@ -1,25 +1,29 @@
 module FileManager.Update exposing (..)
 
-import FileManager.Action exposing (..)
 import Browser.Navigation exposing (reload)
-import FileManager.Env exposing (handleEnvMsg)
 import File.Download
 import File.Select
 import List exposing (map, filter)
 import Http
-import FileManager.Model exposing (..)
 import Maybe
+import Dict exposing (Dict)
+
+import FileManager.Model exposing (..)
 import FileManager.Vec exposing (..)
+import FileManager.Action exposing (..)
+import FileManager.Env exposing (handleEnvMsg)
+import FileManager.Util exposing (getDirPath)
+
 
 init : Flags -> (Model, Cmd Msg)
-init flags = (initModel flags, let { api, dir } = flags in listDirectory api dir)
+init flags = (initModel flags, let { api, dir } = flags in listDirectory api [dir] )
 
 initModel : Flags -> Model
 initModel { api, thumbnailsUrl, downloadsUrl, dir, hasWriteRights } =
   { api = api
   , thumbnailsUrl = thumbnailsUrl
   , downloadsUrl = downloadsUrl
-  , dir = dir
+  , dir  = [ dir ]
   , open = False
   , load = False
   , pos1 = Vec2 0 0
@@ -43,6 +47,9 @@ initModel { api, thumbnailsUrl, downloadsUrl, dir, hasWriteRights } =
   , clipboardFiles = []
   , uploadQueue = []
   , hasWriteRights = hasWriteRights
+  , viewMode = GridView
+  , filters = Filters "" FileName Asc []
+  , tree = Dict.empty
   }
 
 update : Msg -> Model -> (Model, Cmd Msg)
@@ -58,7 +65,7 @@ update msg model = case msg of
       , filesAmount = List.length files + 1
       , showDrop = False
       }
-      , FileManager.Action.upload model.api model.dir file
+      , FileManager.Action.upload model.api (getDirPath model.dir) file
     )
   Progress progress -> ({ model | progress = progress }, Cmd.none)
   Cancel -> (model, reload)
@@ -71,7 +78,7 @@ update msg model = case msg of
             },
             Cmd.batch
               [ listDirectory model.api model.dir
-              , FileManager.Action.upload model.api model.dir file
+              , FileManager.Action.upload model.api (getDirPath model.dir) file
               ]
           )
         _ -> ({ model | filesAmount = 0 }, listDirectory model.api model.dir)
@@ -80,7 +87,7 @@ update msg model = case msg of
     let
       cmd =
         case state of
-          Edit file _ -> getContent model.api model.dir file
+          Edit file _ -> getContent model.api (getDirPath model.dir) file
           _ -> Cmd.none
     in
     ( { model
@@ -104,21 +111,21 @@ update msg model = case msg of
   ConfirmNameDialog ->
     case model.dialogState of
       Closed -> (model,Cmd.none)
-      NewDir s -> ({ model | dialogState = Closed, load = True }, newDir model.api model.dir s)
-      NewFile s -> ({ model | dialogState = Closed, load = True }, newFile model.api model.dir s)
-      Rename f s -> ({ model | dialogState = Closed, load = True },FileManager.Action.rename model.api model.dir f.name s)
-      Edit file content -> ({ model | dialogState = Closed, load = True },saveContent model.api model.dir file content)
+      NewDir s -> ({ model | dialogState = Closed, load = True }, newDir model.api (getDirPath model.dir) s)
+      NewFile s -> ({ model | dialogState = Closed, load = True }, newFile model.api (getDirPath model.dir) s)
+      Rename f s -> ({ model | dialogState = Closed, load = True },FileManager.Action.rename model.api (getDirPath model.dir) f.name s)
+      Edit file content -> ({ model | dialogState = Closed, load = True },saveContent model.api (getDirPath model.dir) file content)
 
   Download ->
     ( { model
       | showContextMenu = False
       }
       , Cmd.batch
-      <| map (File.Download.url << (++) (model.downloadsUrl  ++ "?action=download&path=" ++ model.dir) << .name)
+      <| map (File.Download.url << (++) (model.downloadsUrl  ++ "?action=download&path=" ++ (getDirPath model.dir)) << .name)
       <| filter (.type_ >> (/=) "dir") model.selected
     )
-  Cut -> ({ model | clipboardDir = model.dir, clipboardFiles = model.selected, showContextMenu = False }, Cmd.none)
-  Paste -> if model.dir == model.clipboardDir
+  Cut -> ({ model | clipboardDir = (getDirPath model.dir), clipboardFiles = model.selected, showContextMenu = False }, Cmd.none)
+  Paste -> if (getDirPath model.dir) == model.clipboardDir
     then ({ model | clipboardFiles = [], showContextMenu = False }, Cmd.none)
     else
       ( { model
@@ -128,11 +135,16 @@ update msg model = case msg of
       }
       , case model.caller of
           Just file -> if file.type_ == "dir"
-            then move model.api model.clipboardDir model.clipboardFiles <| model.dir ++ file.name ++ "/"
+            then move model.api model.clipboardDir model.clipboardFiles <| (getDirPath model.dir) ++ file.name ++ "/"
             else Cmd.none
-          Nothing -> move model.api model.clipboardDir model.clipboardFiles model.dir
+          Nothing -> move model.api model.clipboardDir model.clipboardFiles (getDirPath model.dir)
       )
-  Delete -> ({ model | showContextMenu = False, load = True }, delete model.api  model.dir model.selected)
-  UpdateApiPath apiPath -> ({model | api = apiPath, downloadsUrl =  apiPath } , listDirectory apiPath "")
+  Delete -> ({ model | showContextMenu = False, load = True }, delete model.api (getDirPath model.dir) model.selected)
+
+  UpdateApiPath apiPath -> ({model | api = apiPath, downloadsUrl =  apiPath } , listDirectory apiPath ["/"])
+
+  ChangeViewMode viewMode -> ({model | viewMode = viewMode}, Cmd.none)
+
+  UpdateFilters filters -> ({model | filters = filters}, Cmd.none)
 
   None -> (model, Cmd.none)
diff --git a/webapp/sources/rudder/rudder-web/src/main/elm/sources/FileManager/Util.elm b/webapp/sources/rudder/rudder-web/src/main/elm/sources/FileManager/Util.elm
@@ -45,3 +45,7 @@ isJust maybe = case maybe of
 
 button : List (Attribute msg) -> List (Html msg) -> Html msg
 button atts childs = Html.button (type_ "button" :: atts) childs
+
+getDirPath : List String -> String
+getDirPath dir =
+  String.replace "//" "/" ((String.join "/" dir) ++ "/")