Widget.hs.golden

{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NoFieldSelectors #-}
{-# LANGUAGE OverloadedRecordDot #-}
{-# LANGUAGE TypeApplications #-}

module Schema.Widget
  ( WidgetTable (..),
    WidgetRow (..),
    WidgetSelect (..),
    WidgetPicked (..),
    widgetSelect,
    widgetSelectColumns,
    parseWidgetPicked,
    toWidgetPicked,
    WidgetCreate (..),
    WidgetUpdate (..),
    widgetId,
    widgetCreatedAt,
    widgetUpdatedAt,
    widgetName,
    widgetDescription
  )
where

import Data.Text (Text)
import Data.Time (UTCTime)
import Data.UUID (UUID)
import Poppy.Internal.Generated
  ( FromRow (..),
    RowParser,
    field,
    Entity (..),
    Field (..),
    PrimaryKeyType,
    ModelTable,
    Picked (..),
    picked,
    Insertable (..),
    emptyInsert,
    NullableValue (..),
    set,
    setMaybe,
    setNullable,
    Updatable (..),
    emptyUpdate,
    setFieldMaybe,
    setFieldNullable
  )

data WidgetTable = WidgetTable

type instance PrimaryKeyType WidgetTable = UUID

type instance ModelTable "Widget" = WidgetTable

instance Entity WidgetTable where
  tableName = "test_widget"
  primaryKey = widgetId
  tableColumns = ["id", "created_at", "updated_at", "name", "description"]
  uniqueKeys = [["id"], ["name"]]

instance Insertable WidgetTable where
  type CreateInput WidgetTable = WidgetCreate
  toInsertBuilder input =
    setMaybe widgetId input.id $
      setMaybe widgetCreatedAt input.createdAt $
      setMaybe widgetUpdatedAt input.updatedAt $
      set widgetName input.name $
      setNullable widgetDescription input.description $
      emptyInsert @WidgetTable


instance Updatable WidgetTable where
  type UpdateInput WidgetTable = WidgetUpdate
  updatedAtField = Just widgetUpdatedAt
  toUpdateBuilder input =
    setFieldMaybe widgetCreatedAt input.createdAt $
      setFieldMaybe widgetUpdatedAt input.updatedAt $
      setFieldMaybe widgetName input.name $
      setFieldNullable widgetDescription input.description $
      emptyUpdate @WidgetTable


data WidgetRow = WidgetRow
  { id :: UUID,
    createdAt :: UTCTime,
    updatedAt :: UTCTime,
    name :: Text,
    description :: Maybe Text
  }
  deriving (Show, Eq)


data WidgetCreate = WidgetCreate
  { id :: Maybe UUID,
    createdAt :: Maybe UTCTime,
    updatedAt :: Maybe UTCTime,
    name :: Text,
    description :: NullableValue Text
  }
  deriving (Show, Eq)


data WidgetUpdate = WidgetUpdate
  { createdAt :: Maybe UTCTime,
    updatedAt :: Maybe UTCTime,
    name :: Maybe Text,
    description :: NullableValue Text
  }
  deriving (Show, Eq)


instance FromRow WidgetRow where
  fromRow = WidgetRow <$> field <*> field <*> field <*> field <*> field


data WidgetSelect = WidgetSelect
  { id :: Bool,
    createdAt :: Bool,
    updatedAt :: Bool,
    name :: Bool,
    description :: Bool
  }
  deriving (Show, Eq)
data WidgetPicked = WidgetPicked
  { id :: UUID,
    createdAt :: Picked UTCTime,
    updatedAt :: Picked UTCTime,
    name :: Picked Text,
    description :: Picked (Maybe Text)
  }
  deriving (Show, Eq)
widgetSelect :: WidgetSelect
widgetSelect =
  WidgetSelect
    { id = False,
      createdAt = False,
      updatedAt = False,
      name = False,
      description = False
    }
widgetSelectColumns :: WidgetSelect -> [Text]
widgetSelectColumns select_ =
  fieldColumn widgetId
    : concat
      [ [fieldColumn widgetCreatedAt | select_.createdAt]
      , [fieldColumn widgetUpdatedAt | select_.updatedAt]
      , [fieldColumn widgetName | select_.name]
      , [fieldColumn widgetDescription | select_.description]
      ]
parseWidgetPicked :: WidgetSelect -> RowParser WidgetPicked
parseWidgetPicked select_ = do
  idVal <- field
  createdAtVal <- if select_.createdAt then Picked <$> field else pure Skipped
  updatedAtVal <- if select_.updatedAt then Picked <$> field else pure Skipped
  nameVal <- if select_.name then Picked <$> field else pure Skipped
  descriptionVal <- if select_.description then Picked <$> field else pure Skipped
  pure WidgetPicked { id = idVal, createdAt = createdAtVal, updatedAt = updatedAtVal, name = nameVal, description = descriptionVal }
toWidgetPicked :: WidgetSelect -> WidgetRow -> WidgetPicked
toWidgetPicked select_ row =
  WidgetPicked
    { id = row.id,
      createdAt = picked select_.createdAt row.createdAt,
      updatedAt = picked select_.updatedAt row.updatedAt,
      name = picked select_.name row.name,
      description = picked select_.description row.description
    }


widgetId :: Field WidgetTable UUID
widgetId = Field "id" "id"

widgetCreatedAt :: Field WidgetTable UTCTime
widgetCreatedAt = Field "createdAt" "created_at"

widgetUpdatedAt :: Field WidgetTable UTCTime
widgetUpdatedAt = Field "updatedAt" "updated_at"

widgetName :: Field WidgetTable Text
widgetName = Field "name" "name"

widgetDescription :: Field WidgetTable Text
widgetDescription = Field "description" "description"