genesis (empty) → 0.0.1.0

raw patch · 10 files changed

+410/−0 lines, 10 filesdep +basedep +directorydep +envparsesetup-changed

Dependencies added: base, directory, envparse, file-embed, filepath, genesis, hspec, monad-control, monad-logger, monad-persist, persistent, persistent-postgresql, persistent-sqlite, persistent-template, resource-pool, template-haskell, text, text-conversions

Files

• CHANGELOG.md +3/−0
• Setup.hs +7/−0
• genesis.cabal +73/−0
• library/Genesis/Persist.hs +16/−0
• library/Genesis/Persist/Base.hs +77/−0
• library/Genesis/Persist/Migrate.hs +102/−0
• package.yaml +71/−0
• stack.yaml +9/−0
• test-suite/Genesis/MigrateSpec.hs +51/−0
• test-suite/Main.hs +1/−0

@@ -0,0 +1,3 @@+## 0.0.1.0 (April 24th, 2017)++- Initial release

@@ -0,0 +1,7 @@+-- This script is used to build and install your package. Typically you don't+-- need to change it. The Cabal documentation has more information about this+-- file: <https://www.haskell.org/cabal/users-guide/installing-packages.html>.+import qualified Distribution.Simple++main :: IO ()+main = Distribution.Simple.defaultMain

@@ -0,0 +1,73 @@+-- This file has been generated from package.yaml by hpack version 0.15.0.+--+-- see: https://github.com/sol/hpack++name:           genesis+version:        0.0.1.0+synopsis:       Opinionated bootstrapping for Haskell web services.+description:    Opinionated bootstrapping for Haskell web services.+category:       Other+homepage:       https://github.com/cjdev/genesis#readme+bug-reports:    https://github.com/cjdev/genesis/issues+maintainer:     Alexis King <lexi.lambda@gmail.com>+copyright:      2017 CJ Affiliate by Conversant+license:        ISC+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    CHANGELOG.md+    package.yaml+    stack.yaml++source-repository head+  type: git+  location: https://github.com/cjdev/genesis++library+  hs-source-dirs:+      library+  default-extensions: ConstraintKinds DeriveGeneric DuplicateRecordFields FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns OverloadedStrings RankNTypes ScopedTypeVariables TypeApplications TypeOperators+  ghc-options: -Wall+  build-depends:+      base                   >= 4.9.0.0 && < 5+    , directory              >= 1.2.7.0+    , envparse               >= 0.3.0 && < 1+    , file-embed             >= 0.0.10 && < 1+    , filepath+    , monad-control          >= 1.0.0.0 && < 2+    , monad-logger           >= 0.3.10+    , monad-persist          >= 0.0.1.0 && < 1+    , persistent             >= 2.5 && < 3+    , persistent-postgresql  >= 2.5 && < 3+    , persistent-template    >= 2.5 && < 3+    , resource-pool+    , template-haskell       >= 2.11.0.0 && < 2.12+    , text+    , text-conversions       >= 0.2.0 && < 1+  exposed-modules:+      Genesis.Persist+      Genesis.Persist.Base+      Genesis.Persist.Migrate+  default-language: Haskell2010++test-suite genesis-test-suite+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs:+      test-suite+  default-extensions: ConstraintKinds DeriveGeneric DuplicateRecordFields FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving KindSignatures LambdaCase MultiParamTypeClasses NamedFieldPuns OverloadedStrings RankNTypes ScopedTypeVariables TypeApplications TypeOperators+  ghc-options: -Wall -rtsopts -threaded -with-rtsopts=-N+  build-depends:+      base+    , genesis+    , hspec+    , monad-control+    , monad-logger+    , monad-persist+    , persistent-sqlite+    , persistent-template+    , text+  other-modules:+      Genesis.MigrateSpec+  default-language: Haskell2010

@@ -0,0 +1,16 @@+module Genesis.Persist+  ( -- * Connecting to PostgreSQL+    -- | The bindings in this section are re-exported from+    -- "Genesis.Persist.Base".+    PostgresOptions(..)+  , postgresOptions+  , withPostgresqlPool+  , withPostgresqlConn+    -- * Compiling and running SQL migrations+    -- | The bindings in this section are re-exported from+    -- "Genesis.Persist.Migrate".+  , runMigrations+  ) where++import Genesis.Persist.Base+import Genesis.Persist.Migrate

@@ -0,0 +1,77 @@+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE NoDuplicateRecordFields #-}++{-|+  This module provides utilities for using PostgreSQL with+  "Control.Monad.Persist" and @persistent@.+-}+module Genesis.Persist.Base+  ( PostgresOptions(..)+  , postgresOptions+  , withPostgresqlPool+  , withPostgresqlConn+  ) where++import qualified Database.Persist.Postgresql as PG+import qualified Env++import Control.Monad ((<=<))+import Control.Monad.Logger (MonadLogger)+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Persist (SqlBackend)+import Data.Monoid ((<>))+import Data.Pool (Pool)+import Data.Text (Text)+import Data.Text.Conversions (fromText, toText, unUTF8)+import GHC.Generics (Generic)++{-|+  Connection options needed to connect to PostgreSQL. You can use+  'postgresOptions' to parse these options from the environment.+-}+data PostgresOptions = PostgresOptions+  { host :: Text+  , port :: Int+  , user :: Text+  , dbName :: Text+  , password :: Text+  } deriving (Eq, Show, Generic)++{-|+  An @envparse@ 'Env.Parser' that parses 'PostgresOptions' from the environment,+  looking for the environment variables @PG_HOST@, @PG_PORT@, @PG_USER@,+  @PG_USER@, @PG_DB_NAME@, and @PG_PASSWORD@. All of them are optional except+  for @PG_DB_NAME@.+-}+postgresOptions :: (Env.AsEmpty e, Env.AsUnread e, Env.AsUnset e) => Env.Parser e PostgresOptions+postgresOptions = PostgresOptions+    <$> Env.var (Env.str <=< Env.nonempty) "PG_HOST" (helpDef "localhost" "host of postgres database")+    <*> Env.var (Env.auto <=< Env.nonempty) "PG_PORT" (helpDef 5432 "port of postgres database")+    <*> Env.var (Env.str <=< Env.nonempty) "PG_USER" (helpDef "postgres" "user to connect to postgres as")+    <*> Env.var (Env.str <=< Env.nonempty) "PG_DB_NAME" (Env.help "postgres database name to connect to")+    <*> Env.var Env.str "PG_PASSWORD" (helpDef "" "password to connect to postgres with")+  where helpDef def msg = Env.def def <> Env.help (msg ++ " (default: " ++ show def ++ ")")++{-|+  Like 'PG.withPostgresqlPool' from "Database.Persist.Postgresql", except using+  'PostgresOptions'.+-}+withPostgresqlPool :: (MonadBaseControl IO m, MonadLogger m, MonadIO m)+                   => PostgresOptions -- ^ Options to connect to the database.+                   -> Int -- ^ Number of connections to be kept open in the pool.+                   -> (Pool SqlBackend -> m a) -- ^ Action to be executed that uses the connection pool.+                   -> m a+withPostgresqlPool opts = PG.withPostgresqlPool (pgConnString opts)++{-|+Like 'PG.withPostgresqlConn' from "Database.Persist.Postgresql", except using+'PostgresOptions'.+-}+withPostgresqlConn :: (MonadBaseControl IO m, MonadLogger m, MonadIO m) => PostgresOptions -> (SqlBackend -> m a) -> m a+withPostgresqlConn opts = PG.withPostgresqlConn (pgConnString opts)++pgConnString :: PostgresOptions -> PG.ConnectionString+pgConnString PostgresOptions { host, port, user, dbName, password } =+  unUTF8 . fromText $ "host=" <> host <> " port=" <> toText (show port) <> " user=" <> user+                   <> " dbname=" <> dbName <> " password=" <> password

@@ -0,0 +1,102 @@+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}+{-# OPTIONS_HADDOCK not-home #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}++{-|+  This module provides functions for creating and running migrations written as+  plain SQL files. By using 'runMigrations', the migrations will be compiled+  directly into your Haskell application using Template Haskell, so the files+  will not need to be present in the eventual runtime environment.++  For more information, see the documentation for 'runMigrations'.+-}+module Genesis.Persist.Migrate (runMigrations, runMigrations') where++import qualified Data.Text.IO as T++import Control.Monad (filterM, forM, forM_, unless, when)+import Control.Monad.Logger (MonadLogger, logDebugNS, logInfoNS)+import Control.Monad.Persist (MonadSqlPersist, insert_, rawExecute, runMigrationSilent, selectList, transactionSave)+import System.Directory (doesDirectoryExist, doesFileExist, doesPathExist, listDirectory)+import System.FilePath ((</>))+import Data.FileEmbed (makeRelativeToProject)+import Data.List (isSuffixOf, sort)+import Data.Monoid ((<>))+import Data.Text (Text)+import Data.Text.Conversions (toText)+import Database.Persist.Sql (Entity(..))+import Database.Persist.TH (share, mkPersist, sqlSettings, mkMigrate, persistLowerCase)+import Language.Haskell.TH+import Language.Haskell.TH.Syntax++share [mkPersist sqlSettings, mkMigrate "migrateSchema"] [persistLowerCase|+SchemaMigration+  name FilePath+  deriving Eq Show+|]++{-|+  Compiles a set of .sql files in a particular directory into your application,+  then runs them against a database at runtime. This function is implemented+  with Template Haskell so that it can read the migration files at compile-time,+  but it semantically has the type+  @('MonadLogger' m, 'MonadSqlPersist' m) => 'FilePath' -> m ()@. Migrations+  will be executed in order based on their filename, according to 'sort'.++  The 'FilePath' provided should be relative to your /project root/, and it will+  detect all files within the immediate directory (that is, /not/ in+  subdirectories) with the suffix @.sql@.++  Example:++  @+  main :: IO ()+  main = 'Control.Monad.Logger.runStderrLoggingT' $ withSqliteConn ":memory:" ('Control.Monad.Persist.runSqlPersistT' $('runMigrations' "db/migrations"))+  @+-}+runMigrations :: FilePath -> Q Exp+runMigrations dir = do+  migrationsDir <- makeRelativeToProject dir+  migrationsDirExists <- runIO $ doesPathExist migrationsDir+  unless migrationsDirExists $+    fail $ "No such directory ‘" ++ dir ++ "’ exists at root of project.\n        (Looking at ‘" ++ migrationsDir ++ "’)."++  migrationsDirIsDir <- runIO $ doesDirectoryExist migrationsDir+  unless migrationsDirIsDir $+    fail $ "The file at ‘" ++ dir ++ "’ in root of project is not a directory.\n        (Looking at ‘" ++ migrationsDir ++ "’)."++  allFiles <- runIO $ listDirectory migrationsDir+  nonDirectoryFiles <- runIO $ filterM (doesFileExist . (migrationsDir </>)) allFiles+  let migrationFiles = sort $ filter (isSuffixOf ".sql") nonDirectoryFiles+  forM_ migrationFiles (addDependentFile . (migrationsDir </>))+  when (null migrationFiles) $+    reportWarning $ "No migrations (files ending in .sql) in ‘" ++ dir ++ "’ at root of project.\n      (Looking in ‘" ++ migrationsDir ++ "’.)\n"++  migrations <- runIO $ forM migrationFiles $ \path -> (path,) <$> T.readFile (migrationsDir </> path)+  [| runMigrations' migrations |]++{-|+  The low-level API that underlies 'runMigrations'. It is unlikely that you will+  need to use this.++  Unlike 'runMigrations', this function does not use Template Haskell.+  Migrations are passed as a list of tuples, where the first element is the name+  of the migration (which must be unique) and the second element is the SQL to+  be run. The migrations will be run in the order they are provided, from left+  to right.+-}+runMigrations' :: (MonadLogger m, MonadSqlPersist m) => [(FilePath, Text)] -> m ()+runMigrations' allMigrations = do+  messages <- runMigrationSilent migrateSchema+  forM_ messages (logDebugNS "SQL")+  transactionSave+  existingMigrations <- map (schemaMigrationName . entityVal) <$> selectList [] []+  let newMigrations = filter (\(path, _) -> path `notElem` existingMigrations) allMigrations+  forM_ newMigrations $ \(path, sql) -> do+    logInfoNS "migrate" $ "migrating ‘" <> toText path <> "’"+    rawExecute sql []+    insert_ (SchemaMigration path)+    transactionSave

@@ -0,0 +1,71 @@+name: genesis+version: 0.0.1.0+category: Other+synopsis: Opinionated bootstrapping for Haskell web services.+description: Opinionated bootstrapping for Haskell web services.+maintainer: Alexis King <lexi.lambda@gmail.com>+copyright: 2017 CJ Affiliate by Conversant+license: ISC+github: cjdev/genesis++extra-source-files:+- CHANGELOG.md+- package.yaml+- stack.yaml++ghc-options: -Wall+default-extensions:+- ConstraintKinds+- DeriveGeneric+- DuplicateRecordFields+- FlexibleContexts+- FlexibleInstances+- GADTs+- GeneralizedNewtypeDeriving+- KindSignatures+- LambdaCase+- MultiParamTypeClasses+- NamedFieldPuns+- OverloadedStrings+- RankNTypes+- ScopedTypeVariables+- TypeApplications+- TypeOperators++library:+  dependencies:+  - base                   >= 4.9.0.0 && < 5+  - directory              >= 1.2.7.0+  - envparse               >= 0.3.0 && < 1+  - file-embed             >= 0.0.10 && < 1+  - filepath+  - monad-control          >= 1.0.0.0 && < 2+  - monad-logger           >= 0.3.10+  - monad-persist          >= 0.0.1.0 && < 1+  - persistent             >= 2.5 && < 3+  - persistent-postgresql  >= 2.5 && < 3+  - persistent-template    >= 2.5 && < 3+  - resource-pool+  - template-haskell       >= 2.11.0.0 && < 2.12+  - text+  - text-conversions       >= 0.2.0 && < 1+  source-dirs: library++tests:+  genesis-test-suite:+    dependencies:+    - base+    - genesis+    - hspec+    - monad-control+    - monad-logger+    - monad-persist+    - persistent-sqlite+    - persistent-template+    - text+    ghc-options:+    - -rtsopts+    - -threaded+    - -with-rtsopts=-N+    main: Main.hs+    source-dirs: test-suite

@@ -0,0 +1,9 @@+resolver: lts-8.11++packages:+- '.'+extra-deps: [monad-persist-0.0.1.0]++flags: {}++extra-package-dbs: []

@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Genesis.MigrateSpec (spec) where++import qualified Test.Hspec as Hspec++import Control.Monad.Logger (NoLoggingT, runNoLoggingT)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Persist (Entity(..), SqlPersistT, insert, runSqlPersistT, selectList)+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.Text (Text)+import Database.Persist.Sqlite (withSqliteConn)+import Database.Persist.TH (mkPersist, persistLowerCase, sqlSettings)+import Test.Hspec hiding (shouldBe)++import Genesis.Persist (runMigrations)++mkPersist sqlSettings [persistLowerCase|+Blog+  name Text+  deriving Eq Show++Post+  title Text+  body Text+  blogId BlogId+  deriving Eq Show+|]++runSqlite :: (MonadIO m, MonadBaseControl IO m) => SqlPersistT (NoLoggingT m) a -> m a+runSqlite x = runNoLoggingT $ withSqliteConn ":memory:" (runSqlPersistT ($(runMigrations "test-suite/migrations") >> x))++shouldBe :: (Eq a, Show a, MonadIO m) => a -> a -> m ()+shouldBe x y = liftIO $ Hspec.shouldBe x y++spec :: Spec+spec = describe "runMigrations" $+  it "executes all SQL migrations in the specified directory" $ example $ runSqlite $ do+    blogId <- insert $ Blog "Alyssa’s Blog"+    let post = Post { postTitle = "First Post", postBody = "world changing post", postBlogId = blogId }+    postId <- insert post+    posts <- selectList [] []+    posts `shouldBe` [Entity postId post]

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}