{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} module Generator.Models where import AST import Data.Maybe import qualified Data.Text as T import Data.List import Text.Shakespeare.Text hiding (toText) import Generator.Common recName :: String -> String -> String recName dt f = lowerFirst dt ++ upperFirst f persistFieldType :: Field -> String persistFieldType f = baseFieldType f ++ " " ++ (boolToMaybe . fieldOptional) f ++ (maybeDefault . fieldDefault) f ++ (maybeDefaultNull f) where maybeDefault (Just d) = " default=" ++ (fieldValueToSql d) maybeDefault _ = " " maybeDefaultNull (Field True _ _ (EntityField _)) = " default=NULL" maybeDefaultNull _ = "" entityFieldTypeName :: Entity -> Field -> String entityFieldTypeName e f = upperFirst $ entityFieldName e f enum :: EnumType -> String enum e = T.unpack $(codegenFile "codegen/enum.cg") where fromPathPieces = concatMap fromPathPiece (enumValues e) toPathPieces = concatMap toPathPiece (enumValues e) parseJSONs = concatMap parseJSON (enumValues e) toJSONs = concatMap toJSON (enumValues e) fromPathPiece v = T.unpack $(codegenFile "codegen/enum-frompathpiece.cg") toPathPiece v = T.unpack $(codegenFile "codegen/enum-topathpiece.cg") parseJSON v = T.unpack $(codegenFile "codegen/enum-parsejson.cg") toJSON v = T.unpack $(codegenFile "codegen/enum-tojson.cg") readsPrecs = concatMap readsPrec (enumValues e) showsPrecs = concatMap showsPrec (enumValues e) readsPrec v = T.unpack $(codegenFile "codegen/enum-readsprec.cg") showsPrec v = T.unpack $(codegenFile "codegen/enum-showsprec.cg") toCharList s = "'" ++ (intercalate "':'" (map (:[]) s)) ++ "'" prefixedValues e = intercalate " | " $ map ((enumName e) ++) $ enumValues e modelField :: Field -> String modelField f = T.unpack $(codegenFile "codegen/model-field.cg") modelUnique :: Unique -> String modelUnique (Unique name fields) = T.unpack $(codegenFile "codegen/model-unique.cg") modelDeriving :: String -> String modelDeriving d = T.unpack $(codegenFile "codegen/model-deriving.cg") model :: Entity -> String model e = T.unpack $(codegenFile "codegen/model-header.cg") ++ (concatMap modelField (entityFields e)) ++ (concatMap modelUnique (entityUniques e)) ++ (concatMap modelDeriving (entityDeriving e)) models :: Module -> String models m = T.unpack $(codegenFile "codegen/models-header.cg") ++ (concatMap model (modEntities m)) ++ (T.unpack $(codegenFile "codegen/models-footer.cg"))