-- This module is used for CustomPersistFieldTest; the TH GHC stage restriction requires it to be here.
-- The code is taken from the Yesod.Text.Markdown package; see https://github.com/yesodweb/persistent/issues/448
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module CustomPersistField where

import Data.String (IsString)
import Data.Text (pack)
import Data.Text.Lazy (toStrict, fromStrict)
import qualified Data.Text.Lazy as TL (Text)

import Init

newtype Markdown = Markdown TL.Text
  deriving (Markdown -> Markdown -> Bool
(Markdown -> Markdown -> Bool)
-> (Markdown -> Markdown -> Bool) -> Eq Markdown
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Markdown -> Markdown -> Bool
$c/= :: Markdown -> Markdown -> Bool
== :: Markdown -> Markdown -> Bool
$c== :: Markdown -> Markdown -> Bool
Eq, Eq Markdown
Eq Markdown
-> (Markdown -> Markdown -> Ordering)
-> (Markdown -> Markdown -> Bool)
-> (Markdown -> Markdown -> Bool)
-> (Markdown -> Markdown -> Bool)
-> (Markdown -> Markdown -> Bool)
-> (Markdown -> Markdown -> Markdown)
-> (Markdown -> Markdown -> Markdown)
-> Ord Markdown
Markdown -> Markdown -> Bool
Markdown -> Markdown -> Ordering
Markdown -> Markdown -> Markdown
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Markdown -> Markdown -> Markdown
$cmin :: Markdown -> Markdown -> Markdown
max :: Markdown -> Markdown -> Markdown
$cmax :: Markdown -> Markdown -> Markdown
>= :: Markdown -> Markdown -> Bool
$c>= :: Markdown -> Markdown -> Bool
> :: Markdown -> Markdown -> Bool
$c> :: Markdown -> Markdown -> Bool
<= :: Markdown -> Markdown -> Bool
$c<= :: Markdown -> Markdown -> Bool
< :: Markdown -> Markdown -> Bool
$c< :: Markdown -> Markdown -> Bool
compare :: Markdown -> Markdown -> Ordering
$ccompare :: Markdown -> Markdown -> Ordering
$cp1Ord :: Eq Markdown
Ord, String -> Markdown
(String -> Markdown) -> IsString Markdown
forall a. (String -> a) -> IsString a
fromString :: String -> Markdown
$cfromString :: String -> Markdown
IsString, Int -> Markdown -> ShowS
[Markdown] -> ShowS
Markdown -> String
(Int -> Markdown -> ShowS)
-> (Markdown -> String) -> ([Markdown] -> ShowS) -> Show Markdown
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Markdown] -> ShowS
$cshowList :: [Markdown] -> ShowS
show :: Markdown -> String
$cshow :: Markdown -> String
showsPrec :: Int -> Markdown -> ShowS
$cshowsPrec :: Int -> Markdown -> ShowS
Show)

instance PersistField Markdown where
  toPersistValue :: Markdown -> PersistValue
toPersistValue (Markdown Text
t) = Text -> PersistValue
PersistText (Text -> PersistValue) -> Text -> PersistValue
forall a b. (a -> b) -> a -> b
$ Text -> Text
toStrict Text
t
  fromPersistValue :: PersistValue -> Either Text Markdown
fromPersistValue (PersistText Text
t) = Markdown -> Either Text Markdown
forall a b. b -> Either a b
Right (Markdown -> Either Text Markdown)
-> Markdown -> Either Text Markdown
forall a b. (a -> b) -> a -> b
$ Text -> Markdown
Markdown (Text -> Markdown) -> Text -> Markdown
forall a b. (a -> b) -> a -> b
$ Text -> Text
fromStrict Text
t
  fromPersistValue PersistValue
wrongValue = Text -> Either Text Markdown
forall a b. a -> Either a b
Left (Text -> Either Text Markdown) -> Text -> Either Text Markdown
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Received " String -> ShowS
forall a. [a] -> [a] -> [a]
++ PersistValue -> String
forall a. Show a => a -> String
show PersistValue
wrongValue String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" when a value of type PersistText was expected."


instance PersistFieldSql Markdown where
    sqlType :: Proxy Markdown -> SqlType
sqlType Proxy Markdown
_ = SqlType
SqlString