forge/Vervis
1
0
Fork 0
Code Pull requests Activity

Migration: Safe IsString instances for Field, Entity, Unique

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

4
src/Data/Char/Local.hs
View file

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

63
src/Database/Persist/Schema.hs
View file

@ -31,15 +31,78 @@ import Prelude
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Reader (ReaderT)
import Data.Char (isAsciiLower, isAsciiUpper)
import Data.String (IsString (..))
import Data.Text (Text)
import Database.Persist.Types (SqlType)
import qualified Data.Text as T (uncons, all, stripPrefix)
import Data.Char.Local (isAsciiLetter)
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 }
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 }
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 MaybeNull = MaybeNull | NotNull