Merge pull request #23 from haskell-works/newhoggy/new-fail-function

Newhoggy/new fail function
haskell-works · Oct 18, 2024 · 50630c6 · 50630c6
2 parents 45f791f + f82dfb9
commit 50630c6
Show file tree

Hide file tree

Showing 2 changed files with 10 additions and 4 deletions.
diff --git a/polysemy/Data/RdsData/Polysemy/Core.hs b/polysemy/Data/RdsData/Polysemy/Core.hs
@@ -109,11 +109,11 @@ initialiseDb = withFrozenCallStack do
     , "  deployed_by      TEXT NOT NULL,"
     , "  CONSTRAINT valid_ulid_constraint"
     , "    CHECK (ulid::text ~ '^[0-9A-HJKMNP-TV-Z]{26}$')"
-    , ");"
+    , ")"
     ]
 
   executeStatement_
-    "CREATE INDEX IF NOT EXISTS idx_migration_created_at ON migration (created_at);"
+    "CREATE INDEX IF NOT EXISTS idx_migration_created_at ON migration (created_at)"
 
   executeStatement_
-    "CREATE INDEX IF NOT EXISTS idx_migration_deployed_by ON migration (deployed_by);"
+    "CREATE INDEX IF NOT EXISTS idx_migration_deployed_by ON migration (deployed_by)"
diff --git a/src/Data/RdsData/Decode/Value.hs b/src/Data/RdsData/Decode/Value.hs
@@ -41,6 +41,8 @@ module Data.RdsData.Decode.Value
   , uuid
   , day
 
+  , fail
+
   ) where
 
 import           Amazonka.Data.Base64
@@ -54,7 +56,7 @@ import           Data.Text                     (Text)
 import           Data.Time
 import           Data.UUID                     (UUID)
 import           Data.Word
-import           Prelude                       hiding (maybe, null)
+import           Prelude                       hiding (fail, maybe, null)
 
 import qualified Amazonka.Data.ByteString      as AWS
 import qualified Data.Aeson                    as J
@@ -87,6 +89,10 @@ instance Monad DecodeValue where
     a' <- a v
     decodeValue (f a') v
 
+fail :: Text -> DecodeValue a
+fail =
+    DecodeValue . const . Left
+
 --------------------------------------------------------------------------------
 
 rdsValue :: DecodeValue Value