implemented a text editor

.gitignore

@@ -11,6 +11,7 @@ result
 
 # runtime files
 *.db3
+editor_root
 
 # editor
-.vscode
+.vscode

app/Api/Api.hs

@@ -33,6 +33,8 @@ import Data.ByteString.UTF8 (ByteString)
 import Data.List (find)
 import Network.HTTP.Types (HeaderName)
 import Text.Regex (matchRegex, mkRegex)
+import System.IO (openFile, IOMode (ReadMode, WriteMode), hGetContents, hPutStr, hClose, writeFile)
+import System.Directory (getDirectoryContents)
 
 type Header = (HeaderName, ByteString)
 type APIResponse = IO (Status, String, [Header])
@@ -93,6 +95,17 @@ apiMap = [
             input <- getRequestBodyChunk r
             let result = code $ unpackBS input
             return (status200, result, [("Content-Disposition", "attachment; filename=\"brainfuck.c\"")])
+        ),
+        ("/editor/new", \r -> do
+            filename <- getRequestBodyChunk r
+            files <- getDirectoryContents "./editor_root"
+            if elem (unpackBS filename) files then do
+                return (status400, j2s [aesonQQ|{"message":"Error! file already exists"}|], jsonHeaders)
+            else do
+                handle <- openFile ("./editor_root/" ++ unpackBS filename) WriteMode
+                hPutStr handle ""
+                hClose handle
+                return (status200, j2s [aesonQQ|{"status":"ok"}|], jsonHeaders)
         )
     ]),
     ("GET", [
@@ -103,6 +116,16 @@ apiMap = [
         ("/guestbook/get", \_ -> do
             entries <- getGuestbook
             return (status200, j2s [aesonQQ|{"entries":#{unpackBS $ toStrict $ encode $ show entries}}|], jsonHeaders)
+        ),
+        ("/editor/sidebar", \_ -> do
+            files <- getDirectoryContents "./editor_root"
+            return (status200, j2s [aesonQQ|#{files}|], jsonHeaders)
+        ),
+        ("/editor/content/.*", \r -> do
+            let filename = unpack $ last $ pathInfo r
+            handle <- openFile ("./editor_root/" ++ filename) ReadMode
+            contents  <- hGetContents handle
+            return (status200, contents, defaultHeaders)
         )
     ]),
     ("PUT", [
@@ -128,6 +151,15 @@ apiMap = [
                     time <- fmap round getPOSIXTime :: IO Int
                     runDb $ insertEntity $ Snake 0 time name score speed fruits
                     return (status200, messageResponse "Success", jsonHeaders)
+        ),
+        ("/editor/content/.*", \r -> do
+            body <- getRequestBodyChunk r
+            let content = unpackBS body
+            let filename = unpack $ last $ pathInfo r
+            handle <- openFile ("./editor_root/" ++ filename) WriteMode
+            hPutStr handle content
+            hClose handle
+            return (status200, messageResponse "ok", jsonHeaders)
         )
     ]),
     ("DELETE", [])

app/Pages/Projects/Editor.hs

@@ -0,0 +1,107 @@
+module Pages.Projects.Editor where
+
+import Text.Blaze.Html (Html)
+import IHP.HSX.QQ (hsx)
+
+commands :: Html
+commands = [hsx|
+    <script>
+        function status_message(message) {
+            var status = document.getElementById("status")
+            status.innerHTML = message
+        }
+
+        function switch_file(filename) {
+            console.log("Switched pane")
+            fetch("/api/editor/content/" + filename, {
+                method: "GET"
+            }).then(response => response.text().then(text => {
+                document.getElementById("editor").value = text
+                document.getElementById("filename").innerHTML = filename
+                status_message("switched file")
+            }))
+        }
+
+        function populate_sidebar() {
+            fetch("/api/editor/sidebar", {
+                method: "GET"
+            }).then(response => response.json().then(async json => {
+                var sidebar = document.getElementById("sidebar")
+                await json.forEach(item => {
+                    if([".", ".."].includes(item))
+                        return
+                    var b = document.createElement("button")
+                    console.log(item)
+                    b.innerHTML = item
+                    b.onclick = _ => switch_file(item)
+                    sidebar.append(b)
+                    sidebar.appendChild(document.createElement("br"))
+                })
+                sidebar.children[0].onclick()
+
+            }))
+        }
+
+        function save_file() {
+            var filename = document.getElementById("filename").innerHTML
+            var content = document.getElementById("editor").value
+            fetch("/api/editor/content/" + filename, {
+                method: "PUT",
+                body: content
+            }).then(_ => status_message("Successfully saved file"))
+        }
+    </script>
+|]
+
+
+sidebar :: Html
+sidebar = [hsx|
+    <input id="new-file">
+    <div id="sidebar"></div>
+    <script>
+        var new_file = document.getElementById("new-file")
+        new_file.onkeypress = event => {
+            if (event.keyCode == 13) {
+                fetch("/api/editor/new", {
+                    method: "POST",
+                    body: new_file.value
+                }).then(async response => {
+                    if (response.status == 200) {
+                        sidebar.innerHTML = ""
+                        await populate_sidebar()
+                        switch_file(new_file.value)
+                    }
+                    else {
+                        status_message("Error, file already exists")
+                    }
+                })
+            }
+        }
+        populate_sidebar()
+    </script>
+|]
+
+mainFrame :: Html
+mainFrame = [hsx|
+    <h3 id="filename"></h3>
+    <textarea style="min-width: 700px; min-height: 300px;" id="editor">
+    </textarea><br>
+    <button onclick="save_file()">Save File</button>
+|]
+
+editor :: Html
+editor = [hsx|
+    For this project, i've written a text editor, feel free to make the files you want, i was considering putting a field for specifying a method to run it but i don't want to create obvious vulnerabilities..
+    {commands}
+    <table>
+        <tr>
+            <th style="width: 300px; text-align: left;">
+                {sidebar}
+            </th>
+            <th>
+                {mainFrame}
+            </th>
+        </tr>
+    </table>
+    <p id="status"></p>
+|]

app/Pages/Projects/Projects.hs

@@ -16,6 +16,7 @@ import Database.Database (prettyPrintSchema)
 import Database.Schema (defs)
 import Layout (layout)
 import Page (Page, PageSetting (Description, Route), getArgs)
+import Pages.Projects.Editor (editor)
 
 defaultProject :: (String, Html)
 defaultProject = ("", section [hsx|
@@ -69,6 +70,7 @@ projectsTree = Tree defaultProject [
     |]) [
         Tree ("Snake", snake) [], 
         Tree ("Brainfuck Transpiler", brainfuck) [],
+        Tree ("Text Editor", editor) [],
         Tree ("Website", mconcat [
             section [hsx|
                 <div style="max-width: 100%">

homepage.cabal

@@ -69,6 +69,7 @@ executable homepage
         Pages.Projects.Projects,
         Pages.Projects.Snake,
         Pages.Projects.Brainfuck,
+        Pages.Projects.Editor,
         Pages.Guestbook.Guestbook,
         Pages.Sources.Sources,
         Pages.Sources.Repo,
@@ -145,4 +146,4 @@ executable repl-homepage
     hs-source-dirs: app
     default-extensions:
         QuasiQuotes,
-        OverloadedStrings
+        OverloadedStrings