diff --git a/src/Data/Char/Local.hs b/src/Data/Char/Local.hs index 9dc1f40..53f9d95 100644 --- a/src/Data/Char/Local.hs +++ b/src/Data/Char/Local.hs @@ -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' diff --git a/src/Database/Persist/Schema.hs b/src/Database/Persist/Schema.hs index 96362d0..2a692cf 100644 --- a/src/Database/Persist/Schema.hs +++ b/src/Database/Persist/Schema.hs @@ -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