Migration: Safe IsString instances for Field, Entity, Unique

This commit is contained in:
fr33domlover 2016-09-01 17:37:20 +00:00
parent e027789fbd
commit cd1f7af46e
2 changed files with 66 additions and 1 deletions

View file

@ -21,8 +21,10 @@ where
import Prelude import Prelude
import Data.Char
isAsciiLetter :: Char -> Bool isAsciiLetter :: Char -> Bool
isAsciiLetter c = 'A' <= c && c <= 'Z' || 'a' <= c && c <= 'z' isAsciiLetter c = isAsciiLower c || isAsciiUpper c
isNewline :: Char -> Bool isNewline :: Char -> Bool
isNewline c = c == '\n' || c == '\r' isNewline c = c == '\n' || c == '\r'

View file

@ -31,15 +31,78 @@ import Prelude
import Control.Monad.IO.Class (MonadIO) import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Reader (ReaderT)
import Data.Char (isAsciiLower, isAsciiUpper)
import Data.String (IsString (..))
import Data.Text (Text) import Data.Text (Text)
import Database.Persist.Types (SqlType) import Database.Persist.Types (SqlType)
import qualified Data.Text as T (uncons, all, stripPrefix)
import Data.Char.Local (isAsciiLetter)
newtype FieldName = FieldName { unFieldName :: Text } newtype FieldName = FieldName { unFieldName :: Text }
instance IsString FieldName where
fromString s =
let t = fromString s
in case T.uncons t of
Nothing -> error "empty field name"
Just (c, r) ->
if isAsciiLower c
then
if T.all isAsciiLetter r
then FieldName t
else
error "non ascii-letter char in field name"
else
error
"field name doesn't start with lowercase \
\ascii letter"
newtype EntityName = EntityName { unEntityName :: Text } newtype EntityName = EntityName { unEntityName :: Text }
instance IsString EntityName where
fromString s =
let t = fromString s
in case T.uncons t of
Nothing -> error "empty entity name"
Just (c, r) ->
if isAsciiUpper c
then
if T.all isAsciiLetter r
then EntityName t
else
error
"non ascii-letter char in entity name"
else
error
"entity name doesn't start with uppercase \
\ascii letter"
newtype UniqueName = UniqueName { unUniqueName :: Text } newtype UniqueName = UniqueName { unUniqueName :: Text }
instance IsString UniqueName where
fromString s =
let t = fromString s
in case T.stripPrefix "Unique" t of
Nothing -> error "unique name doesn't start with \"Unique\""
Just u ->
case T.uncons u of
Nothing -> error "unique name is just \"Unique\""
Just (c, r) ->
if isAsciiUpper c
then
if T.all isAsciiLetter r
then UniqueName t
else
error
"non ascii-letter char in \
\unique name"
else
error
"unique name doesn't follow with \
\uppercase ascii letter after Unique"
data FieldType = FTPrim SqlType | FTRef data FieldType = FTPrim SqlType | FTRef
data MaybeNull = MaybeNull | NotNull data MaybeNull = MaybeNull | NotNull