From ce14bc010a8f97cd3bab6f5cbd998f614b811546 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sun, 14 Aug 2022 15:44:19 +0200
Subject: controlroom: replace servant/lucid with yesod

aka use something meant for webapps to write the webapp
---
 lib/Lucid/Forms.hs | 115 -----------------------------------------------------
 1 file changed, 115 deletions(-)
 delete mode 100644 lib/Lucid/Forms.hs

(limited to 'lib/Lucid')

diff --git a/lib/Lucid/Forms.hs b/lib/Lucid/Forms.hs
deleted file mode 100644
index 918c942..0000000
--- a/lib/Lucid/Forms.hs
+++ /dev/null
@@ -1,115 +0,0 @@
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE DefaultSignatures   #-}
-{-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE FlexibleInstances   #-}
-{-# LANGUAGE LambdaCase          #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications    #-}
-{-# LANGUAGE TypeOperators       #-}
-
-
-module Lucid.Forms ( GToHtmlForm(..)
-                   , GToHtmlFormInput(..)
-                   , ToHtmlForm(..)
-                   , ToHtmlFormInput(..)
-                   , HtmlFormOptions(..)
-                   ) where
-
-import           Data.Maybe           (maybeToList)
-import           Data.Proxy           (Proxy (..))
-import           Data.Text            (Text)
-import qualified Data.Text            as T
-import           Data.Time            (Day)
-import           GHC.Generics         (C1, D1, Generic (Rep), K1, Meta (..),
-                                       Rec0, S1, U1, type (:*:), type (:+:))
-import           GHC.TypeLits         (KnownSymbol, symbolVal)
-import           Lucid                (Html, HtmlT, ToHtml (toHtml), action_,
-                                       div_, for_, form_, id_, input_, label_,
-                                       method_, name_, placeholder_, type_,
-                                       value_)
-import           Lucid.Base           (relaxHtmlT)
-import           Text.ProtocolBuffers (Default (defaultValue))
-
-class GToHtmlFormInput a where
-  gtoHtmlFormInput :: Text -> Proxy (a p) -> Html ()
-
-instance (KnownSymbol name)
-  => GToHtmlFormInput (C1 (MetaCons name f s) U1) where
-  gtoHtmlFormInput group _ = do
-    input_ [type_ "radio", id_ name, value_ name, name_ group] -- need a shared name for all options here
-    label_ [for_ name] (toHtml name)
-    where name = T.pack (symbolVal (Proxy @name))
-
-instance (GToHtmlFormInput l, GToHtmlFormInput r) => GToHtmlFormInput (l :+: r) where
-  gtoHtmlFormInput group _ = do
-    gtoHtmlFormInput group (Proxy @(l _))
-    gtoHtmlFormInput group (Proxy @(r _))
-
--- | ignore constructor & type metainfo
-instance GToHtmlFormInput a => GToHtmlFormInput (D1 r a) where
-  gtoHtmlFormInput group _ = gtoHtmlFormInput group (Proxy @(a _))
-
--- | class for things which can be (single) options (i.e. a single input-tag or
--- | a group of radio buttons) in an html form
-class ToHtmlFormInput a where
-  toFormInput :: Text -> Proxy a -> Html ()
-  default toFormInput :: (GToHtmlFormInput (Rep a)) => Text -> Proxy a -> Html ()
-  toFormInput group p = gtoHtmlFormInput group (Proxy @(Rep a _))
-
-instance ToHtmlFormInput Text where
-  toFormInput name _ = input_ [type_ "text", name_ name, placeholder_ name]
-instance ToHtmlFormInput Day where
-  toFormInput name _ = input_ [type_ "text", name_ name]
-instance ToHtmlFormInput Bool where
-  toFormInput name _ = input_ [type_ "checkbox", name_ name]
-instance ToHtmlFormInput (Maybe Bool) where
-  toFormInput name _ = input_ [type_ "checkbox", name_ name]
-
-
--- | generic conversion of record data types to input forms
-class GToHtmlForm a where
-  gtoHtmlForm :: Proxy (a p) -> Html ()
-
--- | each record field is a form input
-instance (KnownSymbol name, ToHtmlFormInput a)
-  => GToHtmlForm (S1 (MetaSel (Just name) su ss ds) (Rec0 a)) where
-  gtoHtmlForm _ = toFormInput (T.pack (symbolVal (Proxy @name))) (Proxy @a)
-
--- | just chain all fields
-instance (GToHtmlForm l, GToHtmlForm r) => GToHtmlForm (l :*: r) where
-  gtoHtmlForm _ = do
-    gtoHtmlForm (Proxy @(l _))
-    gtoHtmlForm (Proxy @(r _))
-
--- | ignore constructor & type metainfo
-instance GToHtmlForm a => GToHtmlForm (D1 r a) where
-  gtoHtmlForm _ = gtoHtmlForm (Proxy @(a _))
-instance GToHtmlForm a => GToHtmlForm (C1 r a) where
-  gtoHtmlForm _ = gtoHtmlForm (Proxy @(a _))
-
--- | class for things which can be entered via html forms
-class ToHtmlForm a where
-  toHtmlForm :: Monad m => HtmlFormOptions -> Proxy a -> HtmlT m ()
-  default toHtmlForm :: (GToHtmlForm (Rep a), Monad m) => HtmlFormOptions -> Proxy a -> HtmlT m ()
-  toHtmlForm options = relaxHtmlT . genericToHtmlForm options
-
-data HtmlFormOptions = HtmlFormOptions
-  { formAction           :: Maybe Text
-  , formMethod           :: Text
-  , formSubmitButtonText :: Text
-  }
-
-defaultOptions ::HtmlFormOptions
-defaultOptions = HtmlFormOptions Nothing "post" "Ok"
-
-instance Default HtmlFormOptions where
-  defaultValue = defaultOptions
-
-genericToHtmlForm :: (GToHtmlForm (Rep a2)) => HtmlFormOptions -> Proxy a2 -> Html ()
-genericToHtmlForm HtmlFormOptions{..} (Proxy :: Proxy a) =
-  form_ ((method_ formMethod) : maybeToList (fmap action_ formAction)) $ do
-    gtoHtmlForm (Proxy @(Rep a _))
-    input_ [type_ "submit", value_ formSubmitButtonText]
-- 
cgit v1.2.3