{-# language ScopedTypeVariables #-}
{-# language TypeApplications #-}
{-# language ViewPatterns #-}

module Rel8.Type.ReadShow ( ReadShow(..) ) where

-- base
import Data.Proxy ( Proxy( Proxy ) )
import Data.Typeable ( Typeable, typeRep )
import Prelude 
import Text.Read ( readMaybe )

-- rel8
import Rel8.Type ( DBType( typeInformation ) )
import Rel8.Type.Information ( parseTypeInformation )

-- text
import qualified Data.Text as Text


-- | A deriving-via helper type for column types that store a Haskell value
-- using a Haskell's 'Read' and 'Show' type classes.
newtype ReadShow a = ReadShow { ReadShow a -> a
fromReadShow :: a }


instance (Read a, Show a, Typeable a) => DBType (ReadShow a) where
  typeInformation :: TypeInformation (ReadShow a)
typeInformation = (Text -> Either String (ReadShow a))
-> (ReadShow a -> Text)
-> TypeInformation Text
-> TypeInformation (ReadShow a)
forall a b.
(a -> Either String b)
-> (b -> a) -> TypeInformation a -> TypeInformation b
parseTypeInformation Text -> Either String (ReadShow a)
forall a. Read a => Text -> Either String (ReadShow a)
parser ReadShow a -> Text
printer TypeInformation Text
forall a. DBType a => TypeInformation a
typeInformation
    where
      parser :: Text -> Either String (ReadShow a)
parser (Text -> String
Text.unpack -> String
t) = case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
t of
        Just a
ok -> ReadShow a -> Either String (ReadShow a)
forall a b. b -> Either a b
Right (ReadShow a -> Either String (ReadShow a))
-> ReadShow a -> Either String (ReadShow a)
forall a b. (a -> b) -> a -> b
$ a -> ReadShow a
forall a. a -> ReadShow a
ReadShow a
ok
        Maybe a
Nothing -> String -> Either String (ReadShow a)
forall a b. a -> Either a b
Left (String -> Either String (ReadShow a))
-> String -> Either String (ReadShow a)
forall a b. (a -> b) -> a -> b
$ String
"Could not read " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
t String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" as a " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> TypeRep -> String
forall a. Show a => a -> String
show (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy @a))
      printer :: ReadShow a -> Text
printer = String -> Text
Text.pack (String -> Text) -> (ReadShow a -> String) -> ReadShow a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show (a -> String) -> (ReadShow a -> a) -> ReadShow a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadShow a -> a
forall a. ReadShow a -> a
fromReadShow