wip: add union forms - some suggestionsunion-forms

I have not tested this, but I fixed the type errors. Maybe some of these
thoughts help in some way in finishing the PR! :-)

2 files changed, 39 insertions, 3 deletions

diff --git a/frontend/app/Form/Input.hs b/frontend/app/Form/Input.hs
index 67a6d80..5e0feec 100644
--- a/frontend/app/Form/Input.hs
+++ b/frontend/app/Form/Input.hs
@@ -2,23 +2,58 @@ module Form.Input
   ( inputText,
     inputNumber,
     inputUnion,
-    TypeName(..),
-    Type(..)
+    TypeName (..),
+    Type (..),
+    typeName,
+    stringToTypeName,
   )
 where
 
 import Control.Applicative
 import Control.Arrow (first, second)
+import Data.Aeson qualified as A
 import Data.Map qualified as M
+import Data.Maybe (fromMaybe)
 import Form.Internal
+import GHC.Generics (Generic)
 import Miso
 import Miso.String (MisoString, fromMisoString, null, strip, toMisoString)
 
 data TypeName = StringType | NumberType
-  deriving (Eq, Ord)
+  deriving (Eq, Ord, Generic)
+
+instance IsEmpty (TypeName, M.Map TypeName MisoString) where
+  isEmpty (k, kvs) = isEmpty (fromMaybe "" (M.lookup k kvs))
+
+instance A.FromJSON TypeName
+
+instance A.ToJSON TypeName
+
+instance A.FromJSONKey TypeName
+
+instance A.ToJSONKey TypeName
 
 data Type = IsNumber Double | IsString MisoString
 
+instance A.ToJSON Type where
+  toJSON (IsNumber x) = A.Number (realToFrac x)
+  toJSON (IsString x) = A.String x
+
+instance A.FromJSON Type where
+  parseJSON = \case
+    A.Number x -> pure (IsNumber (realToFrac x))
+    A.String x -> pure (IsString x)
+    _ -> fail ""
+
+typeName :: Type -> TypeName
+typeName (IsNumber _) = NumberType
+typeName (IsString _) = StringType
+
+stringToTypeName :: MisoString -> TypeName
+stringToTypeName "number" = NumberType
+stringToTypeName "string" = StringType
+stringToTypeName _ = StringType
+
 inputUnion :: MisoString -> [TypeName] -> Form (TypeName, M.Map TypeName MisoString) (Maybe Type)
 inputUnion label types =
   foldl1 (<|>)
diff --git a/frontend/app/Form/Internal.hs b/frontend/app/Form/Internal.hs
index 35d59e7..6677b2d 100644
--- a/frontend/app/Form/Internal.hs
+++ b/frontend/app/Form/Internal.hs
@@ -3,6 +3,7 @@ module Form.Internal
     mapValues,
     runForm,
     optional,
+    IsEmpty (..),
   )
 where