From be404dc8d08c32a464c3fc7428b2f8ac4da77652 Mon Sep 17 00:00:00 2001
From: xeruf <27jf@pm.me>
Date: Thu, 11 Apr 2024 18:25:09 +0200
Subject: [PATCH] Rename Tasks to Items and fix schema
---
App.cabal | 20 +--
Application/Migration/1681641158.sql | 8 +-
Application/Migration/1712850010.sql | 21 +++
Application/Migration/1712850049.sql | 17 +++
Application/Migration/1712850449.sql | 1 +
Application/Migration/1712850495.sql | 1 +
Application/Migration/1712850525.sql | 2 +
Application/Migration/1712851742.sql | 4 +
Application/Migration/1712852503.sql | 2 +
Application/Migration/1712852577.sql | 1 +
Application/Schema.sql | 27 +++-
README.md | 14 +-
Web/Controller/Items.hs | 183 +++++++++++++++++++++++++++
Web/Controller/Tasks.hs | 125 ------------------
Web/FrontController.hs | 6 +-
Web/Routes.hs | 2 +-
Web/Types.hs | 16 +--
Web/View/Items/Edit.hs | 17 +++
Web/View/{Tasks => Items}/Index.hs | 26 ++--
Web/View/{Tasks => Items}/New.hs | 17 +--
Web/View/Items/Show.hs | 17 +++
Web/View/Tasks/Edit.hs | 17 ---
Web/View/Tasks/Show.hs | 17 ---
flake.nix | 4 +-
static/Q19675.json | 1 +
25 files changed, 349 insertions(+), 217 deletions(-)
create mode 100644 Application/Migration/1712850010.sql
create mode 100644 Application/Migration/1712850049.sql
create mode 100644 Application/Migration/1712850449.sql
create mode 100644 Application/Migration/1712850495.sql
create mode 100644 Application/Migration/1712850525.sql
create mode 100644 Application/Migration/1712851742.sql
create mode 100644 Application/Migration/1712852503.sql
create mode 100644 Application/Migration/1712852577.sql
create mode 100644 Web/Controller/Items.hs
delete mode 100644 Web/Controller/Tasks.hs
create mode 100644 Web/View/Items/Edit.hs
rename Web/View/{Tasks => Items}/Index.hs (50%)
rename Web/View/{Tasks => Items}/New.hs (76%)
create mode 100644 Web/View/Items/Show.hs
delete mode 100644 Web/View/Tasks/Edit.hs
delete mode 100644 Web/View/Tasks/Show.hs
create mode 100644 static/Q19675.json
diff --git a/App.cabal b/App.cabal
index 9463cfc..48adf77 100644
--- a/App.cabal
+++ b/App.cabal
@@ -7,14 +7,14 @@
-- This cabal file is inside your project as some haskell tools only work when there's a cabal file. It's not actually used for anything besides providing support for haskell tools.
--
-name: App
+name: CompareWare
version: 0.1.0.0
-- synopsis:
-- description:
-license: AllRightsReserved
+license: GNU GPLv3
license-file: LICENSE
-author: Developers
-maintainer: developers@example.com
+author: CompareWare Developers
+maintainer: hello@compareware.org
-- copyright:
-- category:
build-type: Simple
@@ -25,10 +25,12 @@ executable App
-- other-modules:
-- other-extensions:
build-depends:
- ihp,
- base,
- wai,
- text
+ ihp
+ , base
+ , wai
+ , text
+ , http-conduit
+ , aeson
hs-source-dirs: .
default-language: Haskell2010
extensions:
@@ -68,4 +70,4 @@ executable App
, FunctionalDependencies
, PartialTypeSignatures
, StandaloneDeriving
- , DerivingVia
\ No newline at end of file
+ , DerivingVia
diff --git a/Application/Migration/1681641158.sql b/Application/Migration/1681641158.sql
index 0d00bd0..bb0a79a 100644
--- a/Application/Migration/1681641158.sql
+++ b/Application/Migration/1681641158.sql
@@ -1,11 +1,11 @@
-CREATE TABLE tasks (
+CREATE TABLE items (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
description TEXT NOT NULL
);
CREATE TABLE tags (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
name TEXT NOT NULL,
- task_id UUID NOT NULL
+ item_id UUID NOT NULL
);
-CREATE INDEX tags_task_id_index ON tags (task_id);
-ALTER TABLE tags ADD CONSTRAINT tags_ref_task_id FOREIGN KEY (task_id) REFERENCES tasks (id) ON DELETE NO ACTION;
+CREATE INDEX tags_item_id_index ON tags (item_id);
+ALTER TABLE tags ADD CONSTRAINT tags_ref_item_id FOREIGN KEY (item_id) REFERENCES items (id) ON DELETE NO ACTION;
diff --git a/Application/Migration/1712850010.sql b/Application/Migration/1712850010.sql
new file mode 100644
index 0000000..8ab2914
--- /dev/null
+++ b/Application/Migration/1712850010.sql
@@ -0,0 +1,21 @@
+ALTER TABLE tags DROP COLUMN item_id;
+ALTER TABLE tags ADD COLUMN item_id TEXT NOT NULL;
+ALTER TABLE tags ADD COLUMN created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL;
+ALTER TABLE tags ADD COLUMN updated_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL;
+DROP TABLE items;
+CREATE FUNCTION set_updated_at_to_now() RETURNS TRIGGER AS $$BEGIN
+ NEW.updated_at = NOW();
+ RETURN NEW;
+END;$$ language PLPGSQL;
+CREATE TABLE items (
+ wikidataid TEXT NOT NULL,
+ description TEXT NOT NULL,
+ created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL,
+ updated_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
+);
+CREATE INDEX tags_item_id_index ON tags (item_id);
+CREATE INDEX tags_created_at_index ON tags (created_at);
+CREATE TRIGGER update_tags_updated_at BEFORE UPDATE ON tags FOR EACH ROW EXECUTE FUNCTION set_updated_at_to_now();
+CREATE INDEX items_created_at_index ON items (created_at);
+CREATE TRIGGER update_items_updated_at BEFORE UPDATE ON items FOR EACH ROW EXECUTE FUNCTION set_updated_at_to_now();
+ALTER TABLE tags ADD CONSTRAINT tags_ref_item_id FOREIGN KEY (item_id) REFERENCES items (id) ON DELETE CASCADE;
diff --git a/Application/Migration/1712850049.sql b/Application/Migration/1712850049.sql
new file mode 100644
index 0000000..bc9981e
--- /dev/null
+++ b/Application/Migration/1712850049.sql
@@ -0,0 +1,17 @@
+
+CREATE FUNCTION set_updated_at_to_now() RETURNS TRIGGER AS $$BEGIN
+ NEW.updated_at = NOW();
+ RETURN NEW;
+END;$$ language PLPGSQL;
+CREATE TABLE items (
+ wikidataid TEXT NOT NULL,
+ description TEXT NOT NULL,
+ created_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL,
+ updated_at TIMESTAMP WITH TIME ZONE DEFAULT now() NOT NULL
+);
+CREATE INDEX tags_item_id_index ON tags (item_id);
+CREATE INDEX tags_created_at_index ON tags (created_at);
+CREATE TRIGGER update_tags_updated_at BEFORE UPDATE ON tags FOR EACH ROW EXECUTE FUNCTION set_updated_at_to_now();
+CREATE INDEX items_created_at_index ON items (created_at);
+CREATE TRIGGER update_items_updated_at BEFORE UPDATE ON items FOR EACH ROW EXECUTE FUNCTION set_updated_at_to_now();
+ALTER TABLE tags ADD CONSTRAINT tags_ref_item_id FOREIGN KEY (item_id) REFERENCES items (id) ON DELETE CASCADE;
diff --git a/Application/Migration/1712850449.sql b/Application/Migration/1712850449.sql
new file mode 100644
index 0000000..92d2111
--- /dev/null
+++ b/Application/Migration/1712850449.sql
@@ -0,0 +1 @@
+ALTER TABLE tags ADD CONSTRAINT tags_ref_item_id FOREIGN KEY (item_id) REFERENCES items (id) ON DELETE CASCADE;
diff --git a/Application/Migration/1712850495.sql b/Application/Migration/1712850495.sql
new file mode 100644
index 0000000..09224cd
--- /dev/null
+++ b/Application/Migration/1712850495.sql
@@ -0,0 +1 @@
+ALTER TABLE tags ADD CONSTRAINT tags_ref_item_id FOREIGN KEY (item_id) REFERENCES items (wikidata_id) ON DELETE CASCADE;
diff --git a/Application/Migration/1712850525.sql b/Application/Migration/1712850525.sql
new file mode 100644
index 0000000..ce28630
--- /dev/null
+++ b/Application/Migration/1712850525.sql
@@ -0,0 +1,2 @@
+ALTER TABLE items ADD CONSTRAINT items_wikidata_id_key UNIQUE(wikidata_id);
+ALTER TABLE tags ADD CONSTRAINT tags_ref_item_id FOREIGN KEY (item_id) REFERENCES items (wikidata_id) ON DELETE CASCADE;
diff --git a/Application/Migration/1712851742.sql b/Application/Migration/1712851742.sql
new file mode 100644
index 0000000..1294e0f
--- /dev/null
+++ b/Application/Migration/1712851742.sql
@@ -0,0 +1,4 @@
+ALTER TABLE items ADD COLUMN id UUID DEFAULT uuid_generate_v4() NOT NULL;
+ALTER TABLE tags DROP COLUMN item_id;
+ALTER TABLE tags ADD COLUMN item_id UUID NOT NULL;
+ALTER TABLE items ADD CONSTRAINT items_wikidata_id_key UNIQUE(wikidata_id);
diff --git a/Application/Migration/1712852503.sql b/Application/Migration/1712852503.sql
new file mode 100644
index 0000000..9f94e69
--- /dev/null
+++ b/Application/Migration/1712852503.sql
@@ -0,0 +1,2 @@
+CREATE INDEX tags_item_id_index ON tags (item_id);
+ALTER TABLE tags ADD CONSTRAINT tags_ref_item_id FOREIGN KEY (item_id) REFERENCES items (id) ON DELETE CASCADE;
diff --git a/Application/Migration/1712852577.sql b/Application/Migration/1712852577.sql
new file mode 100644
index 0000000..0c18718
--- /dev/null
+++ b/Application/Migration/1712852577.sql
@@ -0,0 +1 @@
+ALTER TABLE items ALTER COLUMN description SET DEFAULT '';
diff --git a/Application/Schema.sql b/Application/Schema.sql
index b1bc3ec..b58a2cc 100644
--- a/Application/Schema.sql
+++ b/Application/Schema.sql
@@ -1,13 +1,28 @@
+CREATE FUNCTION set_updated_at_to_now() RETURNS TRIGGER AS $$
+BEGIN
+ NEW.updated_at = NOW();
+ RETURN NEW;
+END;
+$$ language plpgsql;
-- Your database schema. Use the Schema Designer at http://localhost:8001/ to add some tables.
-CREATE TABLE tasks (
+CREATE TABLE items (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
- description TEXT NOT NULL
+ wikidata_id TEXT NOT NULL UNIQUE,
+ description TEXT DEFAULT '' NOT NULL,
+ created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL,
+ updated_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL
);
CREATE TABLE tags (
id UUID DEFAULT uuid_generate_v4() PRIMARY KEY NOT NULL,
+ item_id UUID NOT NULL,
name TEXT NOT NULL,
- task_id UUID NOT NULL,
- value TEXT NOT NULL
+ value TEXT NOT NULL,
+ created_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL,
+ updated_at TIMESTAMP WITH TIME ZONE DEFAULT NOW() NOT NULL
);
-CREATE INDEX tags_task_id_index ON tags (task_id);
-ALTER TABLE tags ADD CONSTRAINT tags_ref_task_id FOREIGN KEY (task_id) REFERENCES tasks (id) ON DELETE NO ACTION;
+CREATE INDEX tags_item_id_index ON tags (item_id);
+CREATE INDEX tags_created_at_index ON tags (created_at);
+CREATE TRIGGER update_tags_updated_at BEFORE UPDATE ON tags FOR EACH ROW EXECUTE FUNCTION set_updated_at_to_now();
+CREATE INDEX items_created_at_index ON items (created_at);
+CREATE TRIGGER update_items_updated_at BEFORE UPDATE ON items FOR EACH ROW EXECUTE FUNCTION set_updated_at_to_now();
+ALTER TABLE tags ADD CONSTRAINT tags_ref_item_id FOREIGN KEY (item_id) REFERENCES items (id) ON DELETE CASCADE;
diff --git a/README.md b/README.md
index 6e81813..d68887f 100644
--- a/README.md
+++ b/README.md
@@ -1,5 +1,8 @@
# [CompareWare](https://compareware.org)
+This application is still a prototype,
+with only a landing page publicly available thus far.
+
## Use-Cases
- Authorised users can create `Items`: Working, no authorisations
- `Items` can have `Tags`: Implemented
@@ -26,11 +29,9 @@ and normalizes the schema.
-Of course, every many-to-many relationship needs another table
-to be represented in a normalized well,
-which the diagram of the actual structure used in the code illustrates:
-
-TODO
+For a fully normalized and implementable view,
+every many-to-many relationship needs another table
+which will be visible in a diagram generated from the [schema](./Application/Schema.sql).
## Developer Setup
@@ -38,3 +39,6 @@ TODO
direnv allow
devenv up
```
+
+Open up http://localhost:8000 and you can create,
+edit and delete items with key-value tags.
diff --git a/Web/Controller/Items.hs b/Web/Controller/Items.hs
new file mode 100644
index 0000000..e0bd346
--- /dev/null
+++ b/Web/Controller/Items.hs
@@ -0,0 +1,183 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Web.Controller.Items where
+
+import Data.Aeson
+import Data.Text (Text)
+import Network.HTTP.Simple (httpJSON, getResponseBody, parseRequest)
+import Control.Monad.IO.Class (liftIO)
+
+import Web.Controller.Prelude
+import Web.View.Items.Index
+import Web.View.Items.New
+import Web.View.Items.Edit
+import Web.View.Items.Show
+
+
+instance Controller ItemsController where
+ action ItemsAction = do
+ items <- query @Item |> fetch
+ >>= collectionFetchRelated #tags
+ render IndexView { .. }
+
+ action NewItemAction = do
+ let tags = [newRecord @Tag, newRecord @Tag]
+ let item = newRecord @Item
+ |> updateField @"tags" tags
+ render NewView { .. }
+
+ action ShowItemAction { itemId } = do
+ item <- fetch itemId
+ render ShowView { .. }
+
+ action EditItemAction { itemId } = do
+ item <- fetch itemId
+ >>= fetchRelated #tags
+ render EditView { .. }
+
+ action UpdateItemAction { itemId } = do
+ item <- fetch itemId
+
+ let tagIds :: [Id Tag] = paramList "tags_id"
+ let tagNames :: [Text] = paramList "tags_name"
+ let tagValues :: [Text] = paramList "tags_value"
+ originalTags <- fetch tagIds
+ let tags = zip3 tagIds tagNames tagValues
+ |> map (\(id, name, value) -> originalTags
+ |> find (\tag -> tag.id == id)
+ |> fromMaybe (newRecord |> set #itemId item.id)
+ |> \tag -> buildTag tag name value
+ )
+
+ item
+ |> buildItem
+ |> updateField @"tags" tags
+ |> bubbleValidationResult #tags
+ |> ifValid \case
+ Left item -> do
+ render EditView { item }
+ Right item -> do
+ (item, tags) <- withTransaction do
+ item <- item
+ |> clearTags
+ |> updateRecord
+ tags <- mapM updateOrCreateRecord tags
+ pure (item, tags)
+
+ setSuccessMessage "Item updated"
+ redirectTo EditItemAction { .. }
+
+ action CreateItemAction = do
+ let item = newRecord @Item
+ let names :: [Text] = paramList "tags_name"
+ let values :: [Text] = paramList "tags_value"
+ let tags = zip names values |> map (\(name, value) -> buildTag newRecord name value)
+
+ -- users <- fetchItems -- Assuming this is your function that returns [User]
+ -- liftIO $ print users
+ -- renderPlain "Check your console!"
+
+ item
+ |> buildItem
+ |> updateField @"tags" tags
+ |> bubbleValidationResult #tags
+ |> ifValid \case
+ Left item -> render NewView { item }
+ Right itemAndTags -> do
+ (item, tags) <- withTransaction do
+ item <- itemAndTags |> clearTags |> createRecord
+ tags <- itemAndTags.tags
+ |> map (set #itemId item.id)
+ |> createMany
+
+ pure (item, tags)
+
+ setSuccessMessage "Item and Tags created"
+ redirectTo ItemsAction
+
+ action DeleteItemAction { itemId } = do
+ item <- fetch itemId
+ deleteRecord item
+ setSuccessMessage "Item deleted"
+ redirectTo ItemsAction
+
+buildItem item = item
+ |> fill @'["description"]
+ |> fill @'["wikidataId"]
+ |> validateField #wikidataId nonEmpty
+
+buildTag :: Tag -> Text -> Text -> Tag
+buildTag tag name value = tag
+ |> set #name name
+ |> set #value value
+ |> validateField #name nonEmpty
+
+-- | Adds a validation error to the record when any of the child records is invalid
+bubbleValidationResult :: forall fieldName record childRecord.
+ ( HasField "meta" record MetaBag
+ , SetField "meta" record MetaBag
+ , KnownSymbol fieldName
+ , HasField fieldName record [childRecord]
+ , HasField "meta" childRecord MetaBag
+ , SetField "meta" childRecord MetaBag
+ ) => Proxy fieldName -> record -> record
+bubbleValidationResult field record =
+ if isEmpty childAnnotations
+ then record
+ else record |> attachFailure field "Invalid records"
+ where
+ childAnnotations :: [(Text, Violation)]
+ childAnnotations = get field record
+ |> map (\record -> record.meta.annotations)
+ |> concat
+
+updateOrCreateRecord record | isNew record = createRecord record
+updateOrCreateRecord record = updateRecord record
+
+clearTags :: Include "tags" Item -> Item
+clearTags item = updateField @"tags" (newRecord @Item).tags item
+
+
+-- data ApiResponse = ApiResponse
+-- { users :: [Item] }
+--
+-- instance FromJSON Item where
+-- parseJSON = withObject "Item" $ \v -> do
+-- let item = newRecord @Item
+-- name <- v .: "name"
+-- -- address <- v .: "address"
+-- -- city <- address .: "city"
+-- newRecord @Item
+-- |> set #description name
+--
+-- instance FromJSON ApiResponse where
+-- parseJSON = withObject "ApiResponse" $ \v -> ApiResponse
+-- <$> v .: "users"
+
+-- Example function to fetch and parse JSON
+-- fetchItems :: [Item]
+-- fetchItems = do
+-- request <- parseRequest "GET https://www.wikidata.org/w/api.php?action=wbgetentities&ids=Q19675&languages=en&format=json" -- http://localhost:8000/Q19675.json
+-- response <- httpJSON request
+-- jsonData <- getResponseBody response
+-- let maybeValue = decodeStrict (cs jsonData) :: Maybe Value
+-- -- let apiResponse = getResponseBody response :: ApiResponse
+-- -- users apiResponse
+-- case maybeValue of
+-- Just value -> do
+-- case extractItemFromJson value of
+-- Just item -> do
+-- item <- item |> createRecord
+-- redirectTo ShowItemAction { itemId = get #id item }
+-- Nothing -> renderPlain "Failed to extract Item data from JSON"
+-- Nothing -> renderPlain "Failed to parse JSON data"
+--
+--
+-- extractItemFromJson :: Value -> Maybe Item
+-- extractItemFromJson value = do
+-- object <- case value of
+-- Object obj -> Just obj
+-- _ -> Nothing
+-- itemId <- object .: "itemId"
+-- itemName <- object .: "itemName" >>= parseJSON
+--
+-- pure Item { id = itemId, description = itemName }
diff --git a/Web/Controller/Tasks.hs b/Web/Controller/Tasks.hs
deleted file mode 100644
index 79278ee..0000000
--- a/Web/Controller/Tasks.hs
+++ /dev/null
@@ -1,125 +0,0 @@
-module Web.Controller.Tasks where
-
-import Web.Controller.Prelude
-import Web.View.Tasks.Index
-import Web.View.Tasks.New
-import Web.View.Tasks.Edit
-import Web.View.Tasks.Show
-
-instance Controller TasksController where
- action TasksAction = do
- tasks <- query @Task |> fetch
- >>= collectionFetchRelated #tags
- render IndexView { .. }
-
- action NewTaskAction = do
- let tags = [newRecord @Tag, newRecord @Tag]
- let task = newRecord @Task
- |> updateField @"tags" tags
- render NewView { .. }
-
- action ShowTaskAction { taskId } = do
- task <- fetch taskId
- render ShowView { .. }
-
- action EditTaskAction { taskId } = do
- task <- fetch taskId
- >>= fetchRelated #tags
- render EditView { .. }
-
- action UpdateTaskAction { taskId } = do
- task <- fetch taskId
-
- let tagIds :: [Id Tag] = paramList "tags_id"
- let tagNames :: [Text] = paramList "tags_name"
- let tagValues :: [Text] = paramList "tags_value"
- originalTags <- fetch tagIds
- let tags = zip3 tagIds tagNames tagValues
- |> map (\(id, name, value) -> originalTags
- |> find (\tag -> tag.id == id)
- |> fromMaybe (newRecord |> set #taskId task.id)
- |> \tag -> buildTag tag name value
- )
-
- task
- |> buildTask
- |> updateField @"tags" tags
- |> bubbleValidationResult #tags
- |> ifValid \case
- Left task -> do
- render EditView { task }
- Right task -> do
- (task, tags) <- withTransaction do
- task <- task
- |> clearTags
- |> updateRecord
- tags <- mapM updateOrCreateRecord tags
- pure (task, tags)
-
- setSuccessMessage "Task updated"
- redirectTo EditTaskAction { .. }
-
- action CreateTaskAction = do
- let task = newRecord @Task
- let names :: [Text] = paramList "tags_name"
- let values :: [Text] = paramList "tags_value"
- let tags = zip names values |> map (\(name, value) -> buildTag newRecord name value)
-
- task
- |> buildTask
- |> updateField @"tags" tags
- |> bubbleValidationResult #tags
- |> ifValid \case
- Left task -> render NewView { task }
- Right taskAndTags -> do
- (task, tags) <- withTransaction do
- task <- taskAndTags |> clearTags |> createRecord
- tags <- taskAndTags.tags
- |> map (set #taskId task.id)
- |> createMany
-
- pure (task, tags)
-
- setSuccessMessage "Task and Tags created"
- redirectTo TasksAction
-
- action DeleteTaskAction { taskId } = do
- task <- fetch taskId
- deleteRecord task
- setSuccessMessage "Task deleted"
- redirectTo TasksAction
-
-buildTask task = task
- |> fill @'["description"]
- |> validateField #description nonEmpty
-
-buildTag :: Tag -> Text -> Text -> Tag
-buildTag tag name value = tag
- |> set #name name
- |> set #value value
- |> validateField #name nonEmpty
-
--- | Adds a validation error to the record when any of the child records is invalid
-bubbleValidationResult :: forall fieldName record childRecord.
- ( HasField "meta" record MetaBag
- , SetField "meta" record MetaBag
- , KnownSymbol fieldName
- , HasField fieldName record [childRecord]
- , HasField "meta" childRecord MetaBag
- , SetField "meta" childRecord MetaBag
- ) => Proxy fieldName -> record -> record
-bubbleValidationResult field record =
- if isEmpty childAnnotations
- then record
- else record |> attachFailure field "Invalid records"
- where
- childAnnotations :: [(Text, Violation)]
- childAnnotations = get field record
- |> map (\record -> record.meta.annotations)
- |> concat
-
-updateOrCreateRecord record | isNew record = createRecord record
-updateOrCreateRecord record = updateRecord record
-
-clearTags :: Include "tags" Task -> Task
-clearTags task = updateField @"tags" (newRecord @Task).tags task
diff --git a/Web/FrontController.hs b/Web/FrontController.hs
index 49509c2..931a756 100644
--- a/Web/FrontController.hs
+++ b/Web/FrontController.hs
@@ -5,14 +5,14 @@ import Web.Controller.Prelude
import Web.View.Layout (defaultLayout)
-- Controller Imports
-import Web.Controller.Tasks
+import Web.Controller.Items
import Web.Controller.Static
instance FrontController WebApplication where
controllers =
- [ startPage TasksAction
+ [ startPage ItemsAction
-- Generator Marker
- , parseRoute @TasksController
+ , parseRoute @ItemsController
]
instance InitControllerContext WebApplication where
diff --git a/Web/Routes.hs b/Web/Routes.hs
index 314ebfc..72c294f 100644
--- a/Web/Routes.hs
+++ b/Web/Routes.hs
@@ -5,5 +5,5 @@ import Web.Types
-- Generator Marker
instance AutoRoute StaticController
-instance AutoRoute TasksController
+instance AutoRoute ItemsController
diff --git a/Web/Types.hs b/Web/Types.hs
index 4f6cf4a..d072b68 100644
--- a/Web/Types.hs
+++ b/Web/Types.hs
@@ -9,12 +9,12 @@ data WebApplication = WebApplication deriving (Eq, Show)
data StaticController = WelcomeAction deriving (Eq, Show, Data)
-data TasksController
- = TasksAction
- | NewTaskAction
- | ShowTaskAction { taskId :: !(Id Task) }
- | CreateTaskAction
- | EditTaskAction { taskId :: !(Id Task) }
- | UpdateTaskAction { taskId :: !(Id Task) }
- | DeleteTaskAction { taskId :: !(Id Task) }
+data ItemsController
+ = ItemsAction
+ | NewItemAction
+ | ShowItemAction { itemId :: !(Id Item) }
+ | CreateItemAction
+ | EditItemAction { itemId :: !(Id Item) }
+ | UpdateItemAction { itemId :: !(Id Item) }
+ | DeleteItemAction { itemId :: !(Id Item) }
deriving (Eq, Show, Data)
diff --git a/Web/View/Items/Edit.hs b/Web/View/Items/Edit.hs
new file mode 100644
index 0000000..b167181
--- /dev/null
+++ b/Web/View/Items/Edit.hs
@@ -0,0 +1,17 @@
+module Web.View.Items.Edit where
+import Web.View.Prelude
+import Web.View.Items.New (renderForm)
+
+data EditView = EditView { item :: Include "tags" Item }
+
+instance View EditView where
+ html EditView { .. } = [hsx|
+ {breadcrumb}
+ Edit Item
+ {renderForm item}
+ |]
+ where
+ breadcrumb = renderBreadcrumb
+ [ breadcrumbLink "Items" ItemsAction
+ , breadcrumbText "Edit Item"
+ ]
\ No newline at end of file
diff --git a/Web/View/Tasks/Index.hs b/Web/View/Items/Index.hs
similarity index 50%
rename from Web/View/Tasks/Index.hs
rename to Web/View/Items/Index.hs
index 70991b6..27f491b 100644
--- a/Web/View/Tasks/Index.hs
+++ b/Web/View/Items/Index.hs
@@ -1,39 +1,39 @@
-module Web.View.Tasks.Index where
+module Web.View.Items.Index where
import Web.View.Prelude
-data IndexView = IndexView { tasks :: [Include "tags" Task] }
+data IndexView = IndexView { items :: [Include "tags" Item] }
instance View IndexView where
html IndexView { .. } = [hsx|
-
+
- | Task |
+ Item |
|
|
|
- {forEach tasks renderTask}
+ {forEach items renderItem}
|]
where
breadcrumb = renderBreadcrumb
- [ breadcrumbLink "Tasks" TasksAction
+ [ breadcrumbLink "Items" ItemsAction
]
-renderTask :: Include "tags" Task -> Html
-renderTask task = [hsx|
+renderItem :: Include "tags" Item -> Html
+renderItem item = [hsx|
- | {task.description} |
- {renderTags task.tags} |
- Show |
- Edit |
- Delete |
+ {item.description} |
+ {renderTags item.tags} |
+ Show |
+ Edit |
+ Delete |
|]
diff --git a/Web/View/Tasks/New.hs b/Web/View/Items/New.hs
similarity index 76%
rename from Web/View/Tasks/New.hs
rename to Web/View/Items/New.hs
index ffb28d4..b155410 100644
--- a/Web/View/Tasks/New.hs
+++ b/Web/View/Items/New.hs
@@ -1,25 +1,26 @@
-module Web.View.Tasks.New where
+module Web.View.Items.New where
import Web.View.Prelude
import Text.Blaze.Html.Renderer.Text
-data NewView = NewView { task :: Include "tags" Task }
+data NewView = NewView { item :: Include "tags" Item }
instance View NewView where
html NewView { .. } = [hsx|
{breadcrumb}
- New Task
+ New Item
- {renderForm task}
+ {renderForm item}
|]
where
breadcrumb = renderBreadcrumb
- [ breadcrumbLink "Tasks" TasksAction
- , breadcrumbText "New Task"
+ [ breadcrumbLink "Items" ItemsAction
+ , breadcrumbText "New Item"
]
-renderForm :: Include "tags" Task -> Html
-renderForm task = formFor task [hsx|
+renderForm :: Include "tags" Item -> Html
+renderForm item = formFor item [hsx|
+ {textField #wikidataId}
{textField #description}