R.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module R where

import Data.Functor.Identity
import Data.Scientific
import Data.Text
import Generics.SOP
import qualified GHC.Generics as GHC
import Text.Digestive as DIG

type FieldValidationError = [Text]

data Person = Person
  { _personId :: Int
  , _personName :: String
  , _personAddress :: String
  } deriving (GHC.Generic, Show)

instance Generic Person
instance HasDatatypeInfo Person

class Validatable a where
  form :: DIG.Form FieldValidationError Identity a

instance Validatable Int where
  form = idForm

instance Validatable String where
  form = DIG.string Nothing

instance Validatable Person where
  form = defaultForm

defaultForm ::
  forall a xs .
  (Generic a, HasDatatypeInfo a, Code a ~ '[ xs ], All Validatable xs)
  => DIG.Form FieldValidationError Identity a
defaultForm =
  to . SOP . Z <$> hsequence fields
  where
    fields = hap fieldNames (hcpure (Proxy :: Proxy Validatable) form)
    fieldNames = fieldInfo (hd (constructorInfo (datatypeInfo (Proxy :: Proxy a))))
    fieldInfo (Record _ x) = hmap (\ (FieldInfo f) -> fn (\ r -> pack f DIG..: r)) x
    fieldInfo _            = hpure (fn id)

idForm :: (Monad m) => DIG.Form FieldValidationError m Int
idForm = floor <$> validateId

scientificForm :: (Monad m) => DIG.Form FieldValidationError m Scientific
scientificForm = DIG.stringRead ["Failed to parse as a number"] Nothing

validateId :: (Monad m) => DIG.Form FieldValidationError m Scientific
validateId = (DIG.validate (\a -> DIG.conditions [conditionGtOne, conditionIsInteger] a) scientificForm)

conditionGtOne :: Scientific -> DIG.Result Text Scientific
conditionGtOne a = if a > 1 then DIG.Success a else DIG.Error "Id should be greater than One"

conditionIsInteger :: Scientific -> DIG.Result Text Scientific
conditionIsInteger a = if isInteger a then DIG.Success a else DIG.Error "Id should be an Integer"

Thanks.