yesod-dsl 0.1.1.7 → 0.1.1.8
raw patch · 6 files changed
+200/−6 lines, 6 files
Files
- Generator/Cabal.hs +76/−0
- Obfuscate.hs +98/−0
- SyncFile.hs +14/−0
- codegen/enums-header.cg +1/−0
- main.hs +7/−5
- yesod-dsl.cabal +4/−1
+ Generator/Cabal.hs view
@@ -0,0 +1,76 @@+module Generator.Cabal (syncCabal) where+import AST+import Distribution.PackageDescription+import Distribution.ModuleName+import Distribution.PackageDescription.Parse+import Distribution.PackageDescription.PrettyPrint+import Distribution.Package+import Distribution.Version+import Data.Maybe (fromMaybe)+import System.Directory+import Distribution.Verbosity+import System.FilePath.Posix+import Data.List+import Generator.Routes+import SyncFile+stripGenerated :: Module -> [ModuleName] -> [ModuleName]+stripGenerated m mods = [ mn | mn <- mods, + not $("Handler." ++ (fromMaybe "" $ modName m)) `isPrefixOf` (mnToString mn) ]+ where mnToString mn = intercalate "." (components mn) ++generatedMods :: Module -> [ModuleName]+generatedMods m = map fromString $ [pfx, pfx ++ ".Internal", pfx ++ ".Enums", pfx ++ ".Routes", pfx ++ ".Esqueleto"]+ ++ [pfx ++ "." ++ (routeModuleName r) | r <- modRoutes m ]+ where pfx = "Handler." ++ (fromMaybe "" $ modName m)++ensureDeps :: [Dependency] -> [Dependency]+ensureDeps deps = nubBy samePackage ([Dependency (PackageName name) AnyVersion + | name <- ["unordered-containers",+ "transformers",+ "tagged",+ "blaze-builder",+ "http-types",+ "wai",+ "resourcet",+ "attoparsec",+ "time",+ "vector",+ "esqueleto",+ "yesod-persistent",+ "old-locale",+ "filepath",+ "unix",+ "path-pieces" ] ] ++ deps)+ where samePackage (Dependency pn1 _) (Dependency pn2 _) = pn1 == pn2+ ++modifyDesc :: Module -> GenericPackageDescription -> GenericPackageDescription+modifyDesc m d = d {+ condLibrary = (condLibrary d) >>= modifyCtree+ }+ where + modifyCtree ctree = Just $ ctree {+ condTreeData = modifyLib (condTreeData ctree),+ condTreeConstraints = ensureDeps (condTreeConstraints ctree)+ }+ modifyLib l = l {+ exposedModules = modifyExposed (exposedModules l) + }+ modifyExposed mods = stripGenerated m mods ++ generatedMods m++syncCabal :: FilePath -> Module -> IO ()+syncCabal path' m = do+ let path = addExtension (dropExtension path') ".cabal"+ e <- doesFileExist path+ if e + then do+ desc <- readPackageDescription verbose path+ + let content = showGenericPackageDescription (modifyDesc m desc)+ syncFile path content++ else return ()+++ +
+ Obfuscate.hs view
@@ -0,0 +1,98 @@+module Obfuscate where+import Data.Hash.MD5+import AST+import Data.Char+hash :: String -> String+hash (s@(x:xs))+ | isUpper x = "I" ++ h+ | otherwise = "i" ++ h+ where h = (md5s (Str s))++obfuscate :: [(FilePath,Module)] -> [(FilePath,Module)]+obfuscate dbs = [ (fp,f m) | (fp,m) <- dbs ]+ where + f m = m {+ modEntities = [ oEntity e | e <- modEntities m ],+ modClasses = [ oClass c | c <- modClasses m ],+ modEnums = [ oEnum e | e <- modEnums m ],+ modRoutes = map oRoute $ modRoutes m+ }+ oEntity e = e {+ entityName = hash $ entityName e,+ entityInstances = [ hash i | i <- entityInstances e],+ entityFields = map oField $ entityFields e,+ entityUniques = map oUnique $ entityUniques e,+ entityChecks = map hash $ entityChecks e+ }+ oField f = f { + fieldName = hash $ fieldName f,+ fieldContent = case (fieldContent f) of+ NormalField _ _ -> fieldContent f+ EntityField en -> EntityField (hash en) + EnumField en -> EnumField (hash en)+ }+ oClass c = c {+ className = hash $ className c,+ classFields = map oField $ classFields c,+ classUniques = map oUnique $ classUniques c+ }+ oUnique u = u {+ uniqueName = hash $ uniqueName u,+ uniqueFields = map hash $ uniqueFields u + }+ oEnum e = e {+ enumName = hash $ enumName e,+ enumValues = map hash $ enumValues e+ }+ oRoute r = r {+ routePath = map oPathPiece $ routePath r,+ routeHandlers = map oHandler $ routeHandlers r + }+ oPathPiece (PathText s) = PathText $ hash s+ oPathPiece (PathId en) = PathId $ hash en++ oHandler h = h {+ handlerParams = map oParam $ handlerParams h+ }+ oParam (Select sq) = Select (oSelectQuery sq)+ oParam (IfFilter (pn,joins,expr)) = IfFilter (hash pn, map oJoin joins,oExpr expr)+ oParam (DeleteFrom en vn expr) = DeleteFrom (hash en) vn (maybe Nothing (Just . oExpr) expr)+ oParam (GetById en ifr vn) = GetById (hash en) (oInputFieldRef ifr) vn+ oParam (Update en ifr ifs) = Update (hash en) (oInputFieldRef ifr)+ (maybe Nothing (Just . (map oInputField)) ifs)+ oParam (Insert en ifs vn) = Insert (hash en) (maybe Nothing (Just . (map oInputField)) ifs) vn+ oParam (Return ofs) = Return ofs+ oParam (Require sq) = Require $ oSelectQuery sq+ oParam p = p+ oSelectQuery sq = sq {+ sqFields = map oSelectField $ sqFields sq,+ sqFrom = (hash en, vn),+ sqJoins = map oJoin $ sqJoins sq,+ sqWhere = maybe Nothing (Just . oExpr) (sqWhere sq),+ sqOrderBy = [ (oFieldRef fr, sd) | (fr,sd) <- sqOrderBy sq ]+ }+ where (en,vn) = sqFrom sq+ oSelectField (SelectField vn fn mvn) = SelectField vn (hash fn) mvn+ oSelectField sf = sf + oJoin join = join {+ joinEntity = hash $ joinEntity join,+ joinExpr = maybe Nothing (Just . oExpr) (joinExpr join) + } + oExpr (AndExpr e1 e2) = AndExpr (oExpr e1) (oExpr e2)+ oExpr (NotExpr e) = NotExpr (oExpr e)+ oExpr (OrExpr e1 e2) = OrExpr (oExpr e1) (oExpr e2)+ oExpr (ListOpExpr fr1 lo fr2) = ListOpExpr (oFieldRef fr1) lo (oFieldRef fr2)+ oExpr (BinOpExpr ve1 op ve2) = BinOpExpr (oValExpr ve1) op (oValExpr ve2)++ oValExpr (FieldExpr fr) = FieldExpr (oFieldRef fr)+ oValExpr (ConcatExpr ve1 ve2) = ConcatExpr (oValExpr ve1) (oValExpr ve2)+ oValExpr ve = ve+ oFieldRef (FieldRefNormal vn fn) = FieldRefNormal vn (hash fn)+ oFieldRef (FieldRefEnum en fn) = FieldRefEnum (hash en) (hash fn)+ oFieldRef (FieldRefSubQuery sq) = FieldRefSubQuery (oSelectQuery sq)+ oFieldRef fr = fr+ oInputField (pn,ifr) = (hash pn,oInputFieldRef ifr)+ oInputFieldRef (InputFieldNormal fn) = (InputFieldNormal $ hash fn)+ oInputFieldRef (InputFieldLocalParamField vn fn) = InputFieldLocalParamField vn (hash fn)+ oInputFieldRef ifr = ifr+
+ SyncFile.hs view
@@ -0,0 +1,14 @@+module SyncFile where+import Prelude hiding (readFile)+import System.IO (FilePath, writeFile)+import System.IO.Strict (readFile)++syncFile :: FilePath -> String -> IO ()+syncFile path content = do+ oldContent <- catch (readFile path) (\_ -> return "")+ if content /= oldContent+ then do+ putStrLn $ "Updating " ++ path+ writeFile path content+ else return ()+
codegen/enums-header.cg view
@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-} module Handler.~{moduleName m}.Enums where import Database.Persist.TH import qualified Data.Aeson as A
main.hs view
@@ -12,25 +12,27 @@ import System.Directory import Control.Monad import System.IO--data Flag = Input FilePath +import Obfuscate +data Flag = Obfuscate deriving Eq options :: [OptDescr Flag] options = [+ Option ['o'] ["obfuscate"] (NoArg Obfuscate) "obfuscated output" ] header = "Usage: yesod-dsl FILE" main = do args <- getArgs case getOpt RequireOrder options args of- (_, (path:_), []) -> main' path+ (o, (path:_), []) -> main' o path (_, _, msgs) -> error $ concat msgs ++ usageInfo header options where - main' path = do- dbs <- parse path+ main' o path = do+ dbs' <- parse path+ let dbs = if Obfuscate `elem` o then obfuscate dbs' else dbs' let ast = implementClasses . mergeModules $ dbs let errors = validate ast if null errors
yesod-dsl.cabal view
@@ -1,5 +1,5 @@ name: yesod-dsl-version: 0.1.1.7+version: 0.1.1.8 license: BSD3 license-file: LICENSE author: Tero Laitinen @@ -41,6 +41,9 @@ Generator.UpdateHandlers Generator.Validation Generator.Require+ Generator.Cabal+ Obfuscate+ SyncFile Validation.Fields Validation.Handlers Validation.State