module Model.Enum
( DBEnum
, readDBEnum
, parseJSONEnum
, enumForm
, pgEnumValues
) where
import Control.Arrow (left)
import qualified Data.Aeson.Types as JSON
import qualified Data.ByteString.Char8 as BSC
import qualified Data.CaseInsensitive as CI (mk)
import qualified Data.Text as T
import Database.PostgreSQL.Typed.Enum (PGEnum, pgEnumValues)
import Text.Read (readMaybe)
import Model.Kind
import HTTP.Form (FormDatum(..))
import HTTP.Form.Deform
class (PGEnum a, Kinded a) => DBEnum a
readDBEnum :: forall a . DBEnum a => String -> Maybe a
readDBEnum s
| Just i <- readMaybe s, i >= fe minBound, i <= fe maxBound = Just (toEnum i)
| [(x, _)] <- filter ((==) s . snd) pgEnumValues = Just x
| [(x, _)] <- filter ((==) (CI.mk s) . CI.mk . snd) pgEnumValues = Just x
| otherwise = Nothing
where
fe :: a -> Int
fe = fromEnum
parseJSONEnum :: forall a . DBEnum a => JSON.Value -> JSON.Parser a
parseJSONEnum (JSON.String t) | Just e <- readDBEnum (T.unpack t) = return e
parseJSONEnum (JSON.Number x) = p (round x) where
p i
| i < fe minBound || i > fe maxBound = fail $ kindOf (undefined :: a) ++ " out of range"
| otherwise = return $ toEnum i
fe :: a -> Int
fe = fromEnum
parseJSONEnum _ = fail $ "Invalid " ++ kindOf (undefined :: a)
enumForm :: forall a m f . (Functor m, Monad m, DBEnum a) => DeformT f m a
enumForm = deformParse minBound fv where
fv (FormDatumBS b) = maybe e return $ readDBEnum $ BSC.unpack b
fv (FormDatumJSON j) = left T.pack $ JSON.parseEither parseJSONEnum j
fv _ = e
e = Left $ "Invalid " `T.append` kindOf (undefined :: a)