refactor: move PendingBang out of Main

1 files changed, 49 insertions, 0 deletions

diff --git a/src/Data/PendingBang.hs b/src/Data/PendingBang.hs
new file mode 100644
index 0000000..05fafba
--- /dev/null
+++ b/src/Data/PendingBang.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings, QuasiQuotes, TemplateHaskell,
+    TypeFamilies, GADTs, GeneralizedNewtypeDeriving,
+    MultiParamTypeClasses, DerivingStrategies, StandaloneDeriving,
+    UndecidableInstances, DataKinds, FlexibleInstances, TypeOperators #-}
+
+{-# OPTIONS -Wno-missing-export-lists #-}
+
+module Data.PendingBang where
+
+import Data.Aeson
+import Database.Persist.TH
+import Data.Char (isAlphaNum)
+import Data.Maybe (maybeToList)
+
+import qualified Data.Text as T
+
+share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
+PendingBang
+    bang T.Text
+    url T.Text
+    displayName T.Text
+    notifyEmail (Maybe T.Text)
+    UniqueBang bang url displayName
+    deriving Show
+|]
+
+instance ToJSON PendingBang where
+    toJSON (PendingBang b u dp em) = object $
+        ["bang" .= b, "url" .= u, "name" .= dp] ++ case em of
+            Nothing -> []
+            Just e -> ["email" .= e]
+
+    toEncoding (PendingBang b u dp em) = pairs $ case em of
+        Nothing -> withoutEmail
+        Just e -> withoutEmail <> "email" .= e
+      where withoutEmail = "bang" .= b <> "url" .= u <> "name" .= dp
+
+instance FromJSON PendingBang where
+    parseJSON = withObject "PendingBang" $ \ob ->
+        PendingBang
+        <$> ob .:  "bang"
+        <*> ob .:  "url"
+        <*> ob .:  "name"
+        <*> ob .:? "email"
+
+verifyPendingBang :: PendingBang -> Bool
+verifyPendingBang (PendingBang n u dp mayEm) =
+    T.all isAlphaNum n && all ((<255) . T.length) strings
+  where strings = [n, u, dp] <> maybeToList mayEm