yesod-dsl 0.1.1.6 → 0.1.1.7

raw patch · 11 files changed

+183/−14 lines, 11 filesdep +Cabaldep +strict

Dependencies added: Cabal, strict

Files

• Generator.hs +30/−9
• Generator/Routes.hs +7/−0
• codegen/dispatch.cg +3/−1
• codegen/esqueleto-header.cg +45/−0
• codegen/header.cg +4/−1
• codegen/route-header.cg +55/−0
• codegen/route-import.cg +1/−0
• codegen/routes-header.cg +23/−1
• codegen/sqlselect-instance.cg +11/−0
• main.hs +1/−1
• yesod-dsl.cabal +3/−1

@@ -3,8 +3,9 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} module Generator (generate, hsRouteName) where-+import Prelude hiding (readFile) import System.IO (FilePath, writeFile)+import System.IO.Strict (readFile) import System.FilePath (joinPath)     import System.Directory (createDirectoryIfMissing) import Data.String.Utils (rstrip)    @@ -13,6 +14,7 @@ import qualified Data.Text as T import Data.List import Data.Maybe+import Control.Monad import Data.Char  import Generator.Models@@ -20,23 +22,42 @@ import Generator.Routes import Generator.Validation import Generator.Handlers+import Generator.EsqueletoInstances+import Generator.Cabal+import SyncFile -generate :: Module -> IO ()-generate m = do+writeRoute :: Module -> Route -> IO ()+writeRoute m r = syncFile (joinPath ["Handler", moduleName m, +                                      routeModuleName r ++ ".hs"]) $+    T.unpack $(codegenFile "codegen/route-header.cg")+        ++ (concatMap (handler m r) (routeHandlers r))+++    +generate :: FilePath -> Module -> IO ()+generate path m = do+    syncCabal path m     createDirectoryIfMissing True (joinPath ["Handler", moduleName m])-    writeFile (joinPath ["Handler", moduleName m, "Enums.hs"]) $+    syncFile (joinPath ["Handler", moduleName m, "Enums.hs"]) $         T.unpack $(codegenFile "codegen/enums-header.cg")             ++ (concatMap enum $ modEnums m)-    writeFile (joinPath ["Handler", moduleName m, "Internal.hs"]) $+    syncFile (joinPath ["Handler", moduleName m, "Esqueleto.hs"]) $+        T.unpack $(codegenFile "codegen/esqueleto-header.cg")+        ++ (esqueletoInstances m)        +    syncFile (joinPath ["Handler", moduleName m, "Internal.hs"]) $         T.unpack $(codegenFile "codegen/header.cg")             ++ models m             ++ classes m             ++ validation m-            ++ (T.unpack $(codegenFile "codegen/json-wrapper.cg"))-            ++ (concat [ handler m r h | r <- modRoutes m, h <- routeHandlers r ])-            ++ routes m-    writeFile (joinPath ["Handler", moduleName m ++ ".hs"]) $ +            ++ (T.unpack $(codegenFile "codegen/json-wrapper.cg"))      +    forM_ (modRoutes m) (writeRoute m)+    syncFile (joinPath ["Handler", moduleName m, "Routes.hs"]) $+           routes m+    syncFile (joinPath ["Handler", moduleName m ++ ".hs"]) $          T.unpack $(codegenFile "codegen/dispatch.cg")+    where+           routeImport r = T.unpack $(codegenFile "codegen/route-import.cg")+                               

@@ -8,6 +8,10 @@ import Data.List import Text.Shakespeare.Text hiding (toText) import Data.Char+routeModuleName :: Route -> String+routeModuleName r = "Route" ++ (concat $ map f (routePath r))+    where f (PathText s) = upperFirst s+          f (PathId en) = upperFirst en hsRouteName :: [PathPiece] -> String hsRouteName = f . routeName      where f ('/':'#':xs) = f xs@@ -28,5 +32,8 @@ routes m = T.unpack $(codegenFile "codegen/routes-header.cg")          ++ (concatMap hsRoutePath (modRoutes m))          ++ (T.unpack $(codegenFile "codegen/routes-footer.cg"))+     where+           routeImport r = T.unpack $(codegenFile "codegen/route-import.cg")+  

@@ -10,9 +10,11 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Handler.~{moduleName m} -    ( module Handler.~{moduleName m}.Enums, module Handler.~{moduleName m}.Internal ) where+    ( module Handler.~{moduleName m}.Enums, module Handler.~{moduleName m}.Internal, module Handler.~{moduleName m}.Routes ) where import Handler.~{moduleName m}.Enums import Handler.~{moduleName m}.Internal+~{concatMap routeImport (modRoutes m)}+import Handler.~{moduleName m}.Routes import Yesod.Core import Yesod.Auth import Yesod.Persist

@@ -0,0 +1,45 @@+{-# LANGUAGE ConstraintKinds+           , FlexibleContexts+           , FlexibleInstances+           , FunctionalDependencies+           , GADTs+           , MultiParamTypeClasses+           , OverloadedStrings+           , UndecidableInstances+ #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}           +module Handler.~{moduleName m}.Esqueleto where+import Prelude+import Control.Applicative (Applicative(..), (<$>), (<$))+import Control.Arrow ((***), first)+import Control.Exception (throw, throwIO)+import Control.Monad ((>=>), ap, void, MonadPlus(..))+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Logger (MonadLogger)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Resource (MonadResourceBase)+import Data.Int (Int64)+import Data.List (intersperse)+import Data.Monoid (Monoid(..), (<>))+import Data.Proxy (Proxy(..))+import qualified Control.Monad.Trans.Reader as R+import qualified Control.Monad.Trans.State as S+import qualified Control.Monad.Trans.Writer as W+import qualified Data.Conduit as C+import qualified Data.Conduit.List as CL+import qualified Data.HashSet as HS+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Builder as TLB+import qualified Data.Text.Lazy.Builder.Int as TLBI++import Database.Esqueleto.Internal.Language+import Database.Esqueleto.Internal.Sql++uncommas :: [TLB.Builder] -> TLB.Builder+uncommas = mconcat . intersperse ", " . filter (/= mempty)++uncommas' :: Monoid a => [(TLB.Builder, a)] -> (TLB.Builder, a)+uncommas' = (uncommas *** mconcat) . unzip++

@@ -14,6 +14,7 @@ {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} module Handler.~{moduleName m}.Internal where import Handler.~{moduleName m}.Enums+import Handler.~{moduleName m}.Esqueleto import Prelude import Database.Esqueleto import Database.Esqueleto.Internal.Sql (unsafeSqlBinOp)@@ -51,6 +52,8 @@ import qualified Data.HashMap.Lazy as HML import qualified Data.HashMap.Strict as HMS +data ~{moduleName m} = ~{moduleName m}+ data FilterJsonMsg = FilterJsonMsg {     filterJsonMsg_type :: Text,     filterJsonMsg_value :: Text,@@ -83,7 +86,7 @@     sortJsonMsg_direction :: Text } -$(deriveJSON (drop 12) ''SortJsonMsg)+$(deriveJSON defaultOptions{fieldLabelModifier = drop 12} ''SortJsonMsg)  -- defaultFilterOp :: forall v typ. PersistField typ => Text -> EntityField v typ -> typ -> Filter v defaultFilterOp "eq" = (==.)

@@ -0,0 +1,55 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ConstraintKinds #-}+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+module Handler.~{moduleName m}.~{routeModuleName r} where+import Handler.~{moduleName m}.Enums+import Handler.~{moduleName m}.Esqueleto+import Handler.~{moduleName m}.Internal+import Prelude+import Database.Esqueleto+import Database.Esqueleto.Internal.Sql (unsafeSqlBinOp)+import qualified Database.Persist as P+import Database.Persist.TH+import Yesod.Auth (requireAuth, requireAuthId, YesodAuth, AuthId, YesodAuthPersist)+import Yesod.Core+import Yesod.Persist (runDB, YesodPersist, YesodPersistBackend)+import Data.Aeson ((.:), (.:?), (.!=), FromJSON, parseJSON, decode)+import Data.Aeson.TH+import Data.Int+import Data.Word+import Data.Time+import Data.Text.Encoding (encodeUtf8)+import Data.Typeable (Typeable)+import qualified Data.Attoparsec as AP+import qualified Data.Aeson as A+import qualified Data.Aeson.Types as AT+import qualified Data.ByteString.Lazy as LBS+import Data.Maybe+import qualified Data.Text.Read+import qualified Data.Text as T+import Data.Text (Text)+import qualified Data.List as DL+import Control.Monad (mzero)+import Control.Monad.Trans.Resource (runResourceT)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Network.HTTP.Conduit as C+import qualified Network.Wai as W+import Data.Conduit.Lazy (lazyConsume)+import Network.HTTP.Types (status200, status400, status403, status404)+import Blaze.ByteString.Builder.ByteString (fromByteString)+import Control.Applicative ((<$>), (<*>))  +import qualified Data.HashMap.Lazy as HML+import qualified Data.HashMap.Strict as HMS+

@@ -0,0 +1,1 @@+import Handler.~{moduleName m}.~{routeModuleName r}

@@ -1,5 +1,27 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ConstraintKinds #-}+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+module Handler.~{moduleName m}.Routes where+import Prelude (const)+import Handler.~{moduleName m}.Enums+import Handler.~{moduleName m}.Esqueleto+import Handler.~{moduleName m}.Internal+~{concatMap routeImport (modRoutes m)}+import Yesod.Auth (requireAuth, requireAuthId, YesodAuth, AuthId, YesodAuthPersist)+import Yesod.Core+import Yesod.Persist (runDB, YesodPersist, YesodPersistBackend) -data ~{moduleName m} = ~{moduleName m}  get~{moduleName m} :: a -> ~{moduleName m} get~{moduleName m} = const ~{moduleName m}

@@ -0,0 +1,11 @@+instance ( ~{intercalate ", " (map sqlSelectTypeLhs nums)} ) => SqlSelect (~{intercalate ", " (map ifield nums)}) (~{intercalate ", " (map ofield nums)}) where+  sqlSelectCols esc (~{intercalate ", " (map ifield nums)}) =+    uncommas' [ ~{intercalate ", " (map sqlSelectCols nums)} ]+  sqlSelectColCount   = sqlSelectColCount . from~{show fnum}P+  sqlSelectProcessRow = fmap to~{show fnum} . sqlSelectProcessRow++from~{show fnum}P :: Proxy (~{intercalate ", " (map ifield nums)}) -> Proxy (~{pairs (map ifield nums)})+from~{show fnum}P = const Proxy++to~{show fnum} :: (~{pairs (map ifield nums)}) -> (~{intercalate ", " (map ifield nums)})+to~{show fnum} (~{pairs (map ifield nums)}) = (~{intercalate ", " (map ifield nums)})

@@ -34,5 +34,5 @@             let ast  = implementClasses . mergeModules $ dbs             let errors = validate ast             if null errors -                then generate $ ast +                then generate path $ ast                  else hPutStrLn stderr errors

@@ -1,5 +1,5 @@ name:           yesod-dsl-version:        0.1.1.6+version:        0.1.1.7 license:        BSD3 license-file:   LICENSE author:         Tero Laitinen @@ -26,6 +26,8 @@                  , filepath >= 1.3.0.0                  , containers >= 0.4.2.1                  , mtl >= 2.1.2+                 , strict+                 , Cabal                       Build-tools:         alex, happy     other-modules: Lexer Parser AST Generator ClassImplementer ModuleMerger Validation