From f9ac4dd0cc2b29eceb1f4e5e207f19c9e7d822f9 Mon Sep 17 00:00:00 2001 From: Thomas Date: Fri, 11 Oct 2024 00:41:20 +0200 Subject: [PATCH] added brainfuck to projects --- app/Api/Api.hs | 53 +++++++++++++++++----------- app/Main.hs | 4 +-- app/Pages/Projects/Brainfuck.hs | 62 +++++++++++++++++++++++++++++++++ app/Pages/Projects/Projects.hs | 2 ++ homepage.cabal | 1 + 5 files changed, 100 insertions(+), 22 deletions(-) create mode 100644 app/Pages/Projects/Brainfuck.hs diff --git a/app/Api/Api.hs b/app/Api/Api.hs index 8c58b86..faa6215 100644 --- a/app/Api/Api.hs +++ b/app/Api/Api.hs @@ -6,6 +6,7 @@ module Api.Api where import qualified Helpers.Tables as T (GuestbookEntry (GuestbookEntry, EmptyGuestbook), LeaderboardEntry (EmptyLeaderboard, LeaderboardEntry), Credentials (EmptyCredentials, Credentials)) import Helpers.Database.Database (getVisits, uuidExists, getGuestbook, runDb) import Helpers.Utils (unpackBS, getDefault) +import Pages.Projects.Brainfuck (code) import IHP.HSX.QQ (hsx) import Text.Blaze.Html (Html) @@ -28,24 +29,31 @@ import Helpers.Logger (info) import Helpers.Database.Schema (GuestbookEntry(guestbookEntryGuestbookTimestamp, guestbookEntryGuestbookName, guestbookEntryGuestbookParentId, guestbookEntryGuestbookContent, GuestbookEntry, guestbookEntryGuestbookId), Snake (Snake), User (User, userUserPassword, userUserName), Token (Token, tokenTokenToken), Visit (Visit), EntityField (UserUserName, TokenTokenName)) import Database.Persist (selectList, Entity (Entity), insertEntity, Filter (Filter), FilterValue (FilterValue), PersistFilter (BackendSpecificFilter)) +import Network.HTTP.Types (HeaderName) +import Data.ByteString.UTF8 (ByteString) +type Header = (HeaderName, ByteString) +type APIResponse = IO (Status, String, [Header]) -handleGuestbookEntry :: T.GuestbookEntry -> IO (Status, String) -handleGuestbookEntry (T.GuestbookEntry "" _ _) = return (status400, "Error, name cannot be empty") -handleGuestbookEntry (T.GuestbookEntry _ "" _) = return (status400, "Error, content cannot be empty") +defaultHeaders :: [Header] +defaultHeaders = [("Content-Type", "text/plain")] + +handleGuestbookEntry :: T.GuestbookEntry -> APIResponse +handleGuestbookEntry (T.GuestbookEntry "" _ _) = return (status400, "Error, name cannot be empty", defaultHeaders) +handleGuestbookEntry (T.GuestbookEntry _ "" _) = return (status400, "Error, content cannot be empty", defaultHeaders) handleGuestbookEntry (T.GuestbookEntry name content parentId) = do time <- fmap round getPOSIXTime :: IO Int runDb $ insertEntity $ GuestbookEntry 0 time name content parentId - return (status200, "Success") + return (status200, "Success", defaultHeaders) -handleLeaderboardEntry :: T.LeaderboardEntry -> IO (Status, String) +handleLeaderboardEntry :: T.LeaderboardEntry -> APIResponse handleLeaderboardEntry (T.LeaderboardEntry name score speed fruits) = do time <- fmap round getPOSIXTime :: IO Int runDb $ insertEntity $ Snake 0 time name score speed fruits - return (status200, "Success") -handleLeaderboardEntry T.EmptyLeaderboard = return (status400, "Error") + return (status200, "Success", defaultHeaders) +handleLeaderboardEntry T.EmptyLeaderboard = return (status400, "Error", defaultHeaders) -handleLogin :: T.Credentials -> IO (Status, String) +handleLogin :: T.Credentials -> APIResponse handleLogin (T.Credentials username password) = do let pass = mkPassword $ pack password rows <- map (\(Entity _ e) -> e) <$> (runDb $ selectList [Filter UserUserName (FilterValue username) (BackendSpecificFilter "LIKE")] [] :: IO [Entity User]) @@ -56,16 +64,16 @@ handleLogin (T.Credentials username password) = do if null rows then do token <- stringRandomIO "[0-9a-zA-Z]{4}-[0-9a-ZA-Z]{10}-[0-9a-zA-Z]{15}" runDb $ insertEntity $ Token 0 (unpack token) username - return (status200, unpack token) + return (status200, unpack token, defaultHeaders) else do let row = head rows - return (status200, tokenTokenToken row) + return (status200, tokenTokenToken row, defaultHeaders) where - PasswordCheckFail -> return (status400, "Wrong username or password") - _ -> return (status400, "Error, no user exists") -handleLogin _ = return (status400, "Invalid request") + PasswordCheckFail -> return (status400, "Wrong username or password", defaultHeaders) + _ -> return (status400, "Error, no user exists", defaultHeaders) +handleLogin _ = return (status400, "Invalid request", defaultHeaders) -api :: [String] -> Request -> IO (Status, String) +api :: [String] -> Request -> APIResponse api ["visits", "new"] request = do body <- getRequestBodyChunk request result <- uuidExists (unpackBS body) @@ -74,12 +82,12 @@ api ["visits", "new"] request = do uuid <- nextRandom runDb $ insertEntity $ Visit 0 time $ toString uuid info "Inserted into db" - return (status200, toString uuid) + return (status200, toString uuid, defaultHeaders) else - return (status200, unpackBS body) + return (status200, unpackBS body, defaultHeaders) api ["visits", "get"] request = do visits <- show . length <$> getVisits - return (status200, visits) + return (status200, visits, []) api ["guestbook", "add"] request = do body <- getRequestBodyChunk request let entry = getDefault T.EmptyGuestbook (decode (fromStrict body) :: Maybe T.GuestbookEntry) @@ -87,7 +95,7 @@ api ["guestbook", "add"] request = do api ["guestbook", "get"] request = do body <- getRequestBodyChunk request entries <- getGuestbook - return (status200, unpackBS $ toStrict $ encode $ show entries) + return (status200, unpackBS $ toStrict $ encode $ show entries, defaultHeaders) api ["snake", "add"] request = do body <- getRequestBodyChunk request let entry = getDefault T.EmptyLeaderboard (decode (fromStrict body) :: Maybe T.LeaderboardEntry) @@ -97,6 +105,11 @@ api ["admin", "login"] request = do let credentials = getDefault T.EmptyCredentials (decode (fromStrict body) :: Maybe T.Credentials) handleLogin credentials api ["hello"] _ = do - return (status200, "Hello World!") + return (status200, "Hello World!", defaultHeaders) +api ["brainfuck"] request = do + input <- getRequestBodyChunk request + let result = code $ unpackBS input + return (status200, result, [("Content-Disposition", "attachment; filename=\"brainfuck.c\"")]) + api xs request = do - return (status404, "{\"error\":\"Endpoint does not exist\"}") + return (status404, "{\"error\":\"Endpoint does not exist\"}", defaultHeaders) diff --git a/app/Main.hs b/app/Main.hs index be3367e..03741df 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -80,8 +80,8 @@ app request respond = do serveFile "static/favicon.ico" else if x == "api" then do -- If the request is to the API - (status, value) <- api (drop 1 xs) request - return $ responseBuilder status [("Content-Type", "text/plain")] $ copyByteString (fromString value) + (status, value, headers) <- api (drop 1 xs) request + return $ responseBuilder status headers $ copyByteString (fromString value) else do -- If the content is to the HTML Frontend let (settings, page) = findPage args diff --git a/app/Pages/Projects/Brainfuck.hs b/app/Pages/Projects/Brainfuck.hs new file mode 100644 index 0000000..a645587 --- /dev/null +++ b/app/Pages/Projects/Brainfuck.hs @@ -0,0 +1,62 @@ +module Pages.Projects.Brainfuck where + +import IHP.HSX.QQ (hsx) +import Text.Blaze.Html (Html) +import Data.List (intercalate) + +import Helpers.CodeBlock (codeBlock) + +convertSymbols :: String -> String +convertSymbols ('+':xs) = "(*ptr)++;\n"++convertSymbols xs +convertSymbols ('-':xs) = "(*ptr)--;\n"++convertSymbols xs +convertSymbols ('>':xs) = "ptr++;\n"++convertSymbols xs +convertSymbols ('<':xs) = "ptr--;\n"++convertSymbols xs +convertSymbols ('[':xs) = "while(*ptr) {\n"++convertSymbols xs +convertSymbols (']':xs) = "}\n"++convertSymbols xs +convertSymbols ('.':xs) = "printf(\"%c\", (*ptr));\n"++convertSymbols xs +convertSymbols (',':xs) = "scanf(\"%c\", ptr);\n"++convertSymbols xs +convertSymbols (x:xs) = convertSymbols xs +convertSymbols [] = [] + +code :: String -> String +code input = intercalate "\n" [ + "#include ", + "#include ", + "#include ", + "char buffer[30000] = {0};", + "char* ptr = buffer;", + "int main () {", + convertSymbols input, + "}" + ] + +brainfuck :: Html +brainfuck = [hsx| + Write some brainfuck code, and you will receive the equivalent in C code.
+ + +
+ +
+ Example: + {codeBlock "txt" "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++."} +|] \ No newline at end of file diff --git a/app/Pages/Projects/Projects.hs b/app/Pages/Projects/Projects.hs index 9f16ebc..7045d68 100644 --- a/app/Pages/Projects/Projects.hs +++ b/app/Pages/Projects/Projects.hs @@ -9,6 +9,7 @@ import Helpers.Tree ( Tree(..) ) import Helpers.Utils (forEach) import Helpers.Section (section) import Pages.Projects.Snake (snake) +import Pages.Projects.Brainfuck (brainfuck) import Helpers.Database.Database (prettyPrintSchema) import Helpers.CodeBlock (codeBlock) @@ -68,6 +69,7 @@ projectsTree = Tree defaultProject [ I find it fun coding in my free time, i do it a lot and as such this website was also born! |]) [ Tree ("Snake", snake) [], + Tree ("Brainfuck Transpiler", brainfuck) [], Tree ("Website", mconcat [section [hsx|
Written in Haskell using IHP-HSX as the primary library, and sqlite-simple as the database implementation.
diff --git a/homepage.cabal b/homepage.cabal index 569a3f6..fa8df6c 100644 --- a/homepage.cabal +++ b/homepage.cabal @@ -27,6 +27,7 @@ executable homepage Pages.Contact.Contact, Pages.Projects.Projects, Pages.Projects.Snake, + Pages.Projects.Brainfuck, Pages.Guestbook.Guestbook, Pages.Sources.Sources, Pages.Sources.Repo,