arne/timetracker-hs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Initial project setup

Browse Source
This commit is contained in:
Arne Weiss
2022-09-02 22:40:21 +02:00
commit ce35c0300c
41 changed files with 1127 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
Web/Controller/Entries.hs Normal file
View File

@@ -0,0 +1,61 @@
module Web.Controller.Entries where
import Web.Controller.Prelude
import Web.View.Entries.Index
import Web.View.Entries.New
import Web.View.Entries.Edit
import Web.View.Entries.Show
import Web.View.Entries.Today
instance Controller EntriesController where
action TodayAction = do
entries <- query @Entry |> fetch
render TodayView { .. }
action EntriesAction = do
entries <- query @Entry |> fetch
render IndexView { .. }
action NewEntryAction = do
let entry = newRecord
render NewView { .. }
action ShowEntryAction { entryId } = do
entry <- fetch entryId
render ShowView { .. }
action EditEntryAction { entryId } = do
entry <- fetch entryId
render EditView { .. }
action UpdateEntryAction { entryId } = do
entry <- fetch entryId
entry
|> buildEntry
|> ifValid \case
Left entry -> render EditView { .. }
Right entry -> do
entry <- entry |> updateRecord
setSuccessMessage "Entry updated"
redirectTo EditEntryAction { .. }
action CreateEntryAction = do
let entry = newRecord @Entry
entry
|> buildEntry
|> ifValid \case
Left entry -> render NewView { .. }
Right entry -> do
entry <- entry |> createRecord
setSuccessMessage "Entry created"
redirectTo EntriesAction
action DeleteEntryAction { entryId } = do
entry <- fetch entryId
deleteRecord entry
setSuccessMessage "Entry deleted"
redirectTo EntriesAction
buildEntry entry = entry
|> fill @["till", "day", "comment", "isfree"]

13
Web/Controller/Prelude.hs Normal file
View File

@@ -0,0 +1,13 @@
module Web.Controller.Prelude
( module Web.Types
, module Application.Helper.Controller
, module IHP.ControllerPrelude
, module Generated.Types
)
where
import Web.Types
import Application.Helper.Controller
import IHP.ControllerPrelude
import Generated.Types
import Web.Routes

6
Web/Controller/Static.hs Normal file
View File

@@ -0,0 +1,6 @@
module Web.Controller.Static where
import Web.Controller.Prelude
import Web.View.Static.Welcome
instance Controller StaticController where
action WelcomeAction = render WelcomeView

21
Web/FrontController.hs Normal file
View File

@@ -0,0 +1,21 @@
module Web.FrontController where
import IHP.RouterPrelude
import Web.Controller.Prelude
import Web.View.Layout (defaultLayout)
-- Controller Imports
import Web.Controller.Entries
import Web.Controller.Static
instance FrontController WebApplication where
controllers =
[ startPage TodayAction
-- Generator Marker
, parseRoute @EntriesController
]
instance InitControllerContext WebApplication where
initContext = do
setLayout defaultLayout
initAutoRefresh

9
Web/Routes.hs Normal file
View File

@@ -0,0 +1,9 @@
module Web.Routes where
import IHP.RouterPrelude
import Generated.Types
import Web.Types
-- Generator Marker
instance AutoRoute StaticController
instance AutoRoute EntriesController

21
Web/Types.hs Normal file
View File

@@ -0,0 +1,21 @@
module Web.Types where
import IHP.Prelude
import IHP.ModelSupport
import Generated.Types
data WebApplication = WebApplication deriving (Eq, Show)
data StaticController = WelcomeAction deriving (Eq, Show, Data)
data EntriesController
= TodayAction
| EntriesAction
| NewEntryAction
| ShowEntryAction { entryId :: !(Id Entry) }
| CreateEntryAction
| EditEntryAction { entryId :: !(Id Entry) }
| UpdateEntryAction { entryId :: !(Id Entry) }
| DeleteEntryAction { entryId :: !(Id Entry) }
deriving (Eq, Show, Data)

26
Web/View/Entries/Edit.hs Normal file
View File

@@ -0,0 +1,26 @@
module Web.View.Entries.Edit where
import Web.View.Prelude
data EditView = EditView { entry :: Entry }
instance View EditView where
html EditView { .. } = [hsx|
{breadcrumb}
<h1>Edit Entry</h1>
{renderForm entry}
|]
where
breadcrumb = renderBreadcrumb
[ breadcrumbLink "Entries" EntriesAction
, breadcrumbText "Edit Entry"
]
renderForm :: Entry -> Html
renderForm entry = formFor entry [hsx|
{(textField #till)}
{(textField #day)}
{(textField #comment)}
{(textField #isfree)}
{submitButton}
|]

39
Web/View/Entries/Index.hs Normal file
View File

@@ -0,0 +1,39 @@
module Web.View.Entries.Index where
import Web.View.Prelude
data IndexView = IndexView { entries :: [Entry] }
instance View IndexView where
html IndexView { .. } = [hsx|
{breadcrumb}
<h1>Index<a href={pathTo NewEntryAction} class="btn btn-primary ml-4">+ New</a></h1>
<div class="table-responsive">
<table class="table">
<thead>
<tr>
<th>Entry</th>
<th></th>
<th></th>
<th></th>
</tr>
</thead>
<tbody>{forEach entries renderEntry}</tbody>
</table>
</div>
|]
where
breadcrumb = renderBreadcrumb
[ breadcrumbLink "Entries" EntriesAction
]
renderEntry :: Entry -> Html
renderEntry entry = [hsx|
<tr>
<td>{entry}</td>
<td><a href={ShowEntryAction entry.id}>Show</a></td>
<td><a href={EditEntryAction entry.id} class="text-muted">Edit</a></td>
<td><a href={DeleteEntryAction entry.id} class="js-delete text-muted">Delete</a></td>
</tr>
|]

26
Web/View/Entries/New.hs Normal file
View File

@@ -0,0 +1,26 @@
module Web.View.Entries.New where
import Web.View.Prelude
data NewView = NewView { entry :: Entry }
instance View NewView where
html NewView { .. } = [hsx|
{breadcrumb}
<h1>New Entry</h1>
{renderForm entry}
|]
where
breadcrumb = renderBreadcrumb
[ breadcrumbLink "Entries" EntriesAction
, breadcrumbText "New Entry"
]
renderForm :: Entry -> Html
renderForm entry = formFor entry [hsx|
{(textField #till)}
{(textField #day)}
{(textField #comment)}
{(textField #isfree)}
{submitButton}
|]

17
Web/View/Entries/Show.hs Normal file
View File

@@ -0,0 +1,17 @@
module Web.View.Entries.Show where
import Web.View.Prelude
data ShowView = ShowView { entry :: Entry }
instance View ShowView where
html ShowView { .. } = [hsx|
{breadcrumb}
<h1>Show Entry</h1>
<p>{entry}</p>
|]
where
breadcrumb = renderBreadcrumb
[ breadcrumbLink "Entries" EntriesAction
, breadcrumbText "Show Entry"
]

19
Web/View/Entries/Today.hs Normal file
View File

@@ -0,0 +1,19 @@
module Web.View.Entries.Today where
import Web.View.Prelude
data TodayView = TodayView { entries :: [Entry] }
instance View TodayView where
html TodayView { .. } = [hsx|
{breadcrumb}
<h1>TodayView</h1>
<button id="today-button" style="width:800px; height:600px">
<input type="image" src="/time_on.svg" width="100%" height="100%" />
</button>
<div>0H 0:00H</div>
|]
where
breadcrumb = renderBreadcrumb
[ breadcrumbLink "Todays" EntriesAction
, breadcrumbText "TodayView"
]

73
Web/View/Layout.hs Normal file
View File

@@ -0,0 +1,73 @@
module Web.View.Layout (defaultLayout, Html) where
import IHP.ViewPrelude
import IHP.Environment
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import Generated.Types
import IHP.Controller.RequestContext
import Web.Types
import Web.Routes
import Application.Helper.View
defaultLayout :: Html -> Html
defaultLayout inner = H.docTypeHtml ! A.lang "en" $ [hsx|
<head>
{metaTags}
{stylesheets}
{scripts}
<title>{pageTitleOrDefault "App"}</title>
</head>
<body>
<div class="container mt-4">
{renderFlashMessages}
{inner}
</div>
</body>
|]
-- The 'assetPath' function used below appends a `?v=SOME_VERSION` to the static assets in production
-- This is useful to avoid users having old CSS and JS files in their browser cache once a new version is deployed
-- See https://ihp.digitallyinduced.com/Guide/assets.html for more details
stylesheets :: Html
stylesheets = [hsx|
<link rel="stylesheet" href={assetPath "/vendor/bootstrap.min.css"}/>
<link rel="stylesheet" href={assetPath "/vendor/flatpickr.min.css"}/>
<link rel="stylesheet" href={assetPath "/app.css"}/>
|]
scripts :: Html
scripts = [hsx|
{when isDevelopment devScripts}
<script src={assetPath "/vendor/jquery-3.6.0.slim.min.js"}></script>
<script src={assetPath "/vendor/timeago.js"}></script>
<script src={assetPath "/vendor/popper.min.js"}></script>
<script src={assetPath "/vendor/bootstrap.min.js"}></script>
<script src={assetPath "/vendor/flatpickr.js"}></script>
<script src={assetPath "/vendor/morphdom-umd.min.js"}></script>
<script src={assetPath "/vendor/turbolinks.js"}></script>
<script src={assetPath "/vendor/turbolinksInstantClick.js"}></script>
<script src={assetPath "/vendor/turbolinksMorphdom.js"}></script>
<script src={assetPath "/helpers.js"}></script>
<script src={assetPath "/ihp-auto-refresh.js"}></script>
<script src={assetPath "/app.js"}></script>
|]
devScripts :: Html
devScripts = [hsx|
<script id="livereload-script" src={assetPath "/livereload.js"} data-ws={liveReloadWebsocketUrl}></script>
|]
metaTags :: Html
metaTags = [hsx|
<meta charset="utf-8"/>
<meta name="viewport" content="width=device-width, initial-scale=1, shrink-to-fit=no"/>
<meta property="og:title" content="App"/>
<meta property="og:type" content="website"/>
<meta property="og:url" content="TODO"/>
<meta property="og:description" content="TODO"/>
{autoRefreshMeta}
|]

14
Web/View/Prelude.hs Normal file
View File

@@ -0,0 +1,14 @@
module Web.View.Prelude
( module IHP.ViewPrelude
, module Web.View.Layout
, module Generated.Types
, module Web.Types
, module Application.Helper.View
) where
import IHP.ViewPrelude
import Web.View.Layout
import Generated.Types
import Web.Types
import Web.Routes ()
import Application.Helper.View

42
Web/View/Static/Welcome.hs Normal file
View File

@@ -0,0 +1,42 @@
module Web.View.Static.Welcome where
import Web.View.Prelude
data WelcomeView = WelcomeView
instance View WelcomeView where
html WelcomeView = [hsx|
<div style="background-color: #657b83; padding-top: 2rem; padding-bottom: 2rem; color:hsla(196, 13%, 96%, 1); border-radius: 4px">
<div style="max-width: 800px; margin-left: auto; margin-right: auto">
<h1 style="margin-bottom: 2rem; font-size: 2rem; font-weight: 300; border-bottom: 1px solid white; padding-bottom: 0.25rem; border-color: hsla(196, 13%, 60%, 1)">
IHP
</h1>
<h2 style="margin-top: 0; margin-bottom: 0rem; font-weight: 900; font-size: 3rem">
It's working!
</h2>
<p style="margin-top: 1rem; font-size: 1.75rem; font-weight: 600; color:hsla(196, 13%, 80%, 1)">
Your new application is up and running.
</p>
<p>
<a
href="https://ihp.digitallyinduced.com/Slack"
style="margin-top: 2rem; background-color: #268bd2; padding: 1rem; border-radius: 3px; color: hsla(205, 69%, 98%, 1); text-decoration: none; font-weight: bold; display: inline-block; box-shadow: 0 4px 6px hsla(205, 69%, 0%, 0.08); transition: box-shadow 0.2s; transition: transform 0.2s;"
target="_blank"
>Join our community on Slack!</a>
</p>
<a href="https://ihp.digitallyinduced.com/Guide/your-first-project.html" style="margin-top: 2rem; background-color: #268bd2; padding: 1rem; border-radius: 3px; color: hsla(205, 69%, 98%, 1); text-decoration: none; font-weight: bold; display: inline-block; box-shadow: 0 4px 6px hsla(205, 69%, 0%, 0.08); transition: box-shadow 0.2s; transition: transform 0.2s;" target="_blank">
Learn the Next Steps in the Documentation
</a>
</div>
</div>
<div style="max-width: 800px; margin-left: auto; margin-right: auto; margin-top: 4rem">
<img src="/ihp-welcome-icon.svg" alt="/ihp-welcome-icon">
<p style="color: hsla(196, 13%, 50%, 1); margin-top: 4rem">
You can modify this start page by making changes to "./Web/View/Static/Welcome.hs".
</p>
</div>
|]