rivet-core (empty) → 0.1.0.0
raw patch · 8 files changed
+604/−0 lines, 8 filesdep +basedep +configuratordep +directorysetup-changed
Dependencies added: base, configurator, directory, directory-tree, filepath, postgresql-simple, process, shake, template-haskell, text, time, unordered-containers
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- rivet-core.cabal +40/−0
- src/Rivet/Common.hs +37/−0
- src/Rivet/Main.hs +115/−0
- src/Rivet/Rules.hs +69/−0
- src/Rivet/TH.hs +58/−0
- src/Rivet/Tasks.hs +253/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Daniel Patterson++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Daniel Patterson nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ rivet-core.cabal view
@@ -0,0 +1,40 @@+-- Initial rivet.cabal generated by cabal init. For further documentation,+-- see http://haskell.org/cabal/users-guide/++name: rivet-core+version: 0.1.0.0+synopsis: Core library for project management tool.+-- description:+homepage: https://github.com/dbp/rivet+license: BSD3+license-file: LICENSE+author: Daniel Patterson+maintainer: dbp@dbpmail.net+-- copyright:+category: Web+build-type: Simple+-- extra-source-files:+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules:+ Rivet.Main+ , Rivet.Common+ , Rivet.Tasks+ , Rivet.TH+ , Rivet.Rules+ build-depends: base >=4.7 && <5+ , directory >= 1.2.1.0+ , shake+ , configurator >= 0.3.0.0+ , text+ , process+ , time >= 1.5 && < 1.6+ , unordered-containers+ , template-haskell+ , directory+ , directory-tree+ , filepath+ , postgresql-simple+ default-language: Haskell2010
+ src/Rivet/Common.hs view
@@ -0,0 +1,37 @@+module Rivet.Common where++import Prelude hiding ((++))++import Control.Applicative+import Data.Char+import Data.Configurator.Types+import Data.Monoid+import Development.Shake+import System.Exit+import System.IO+import System.Process++(++) :: Monoid a => a -> a -> a+(++) = mappend++data Task = Task { taskName :: String+ , taskNumArgs :: Int+ , taskBody :: String -> Config -> [String] -> Action ()+ , taskUsage :: String+ }++exec :: String -> Action ExitCode+exec c = liftIO $ do putStrLn c+ system c++readExec :: String -> Action String+readExec c = liftIO $ do (_,Just out,_, ph) <- createProcess $ (shell c) { std_out = CreatePipe }+ waitForProcess ph+ hGetContents out++stripWhitespace :: String -> String+stripWhitespace = reverse . dropWhile isSpace . reverse . dropWhile isSpace+++getDockerTag :: String -> String -> String -> Action String+getDockerTag proj h env = stripWhitespace <$> readExec ("ssh " ++ h ++ " \"docker ps\" | grep " ++ proj ++ "_" ++ env ++ "_ | awk '{ print $2}' | cut -d ':' -f 2 | head -n1")
+ src/Rivet/Main.hs view
@@ -0,0 +1,115 @@+module Rivet.Main where++import Prelude hiding ((*>), (++))++import Control.Applicative ((<$>))+import Control.Monad (void, when)+import Data.Char (isSpace)+import Data.Configurator+import Data.Configurator.Types+import qualified Data.HashMap.Strict as M+import Data.List (intercalate, isInfixOf)+import Data.Monoid+import qualified Data.Text as T+import Data.Time.Clock+import Data.Time.Format+import Development.Shake hiding (doesFileExist)+import System.Directory (createDirectoryIfMissing,+ doesFileExist, getCurrentDirectory)+import System.Exit+import System.IO+import System.Process++import Rivet.Common+import qualified Rivet.Rules as Rules+import qualified Rivet.Tasks as Tasks++opts :: ShakeOptions+opts = shakeOptions { shakeFiles = ".shake/" }++getProjectName :: IO String+getProjectName = (reverse . takeWhile (/= '/') . reverse) <$>+ getCurrentDirectory++mainWith :: [Task] -> IO ()+mainWith tasks = do+ proj <- getProjectName+ shakeArgsWith opts [] $ \flags targets ->+ case targets of+ ("init":[]) -> do+ e <- doesFileExist "Rivetfile"+ if e+ then+ do putStrLn "Error: Rivetfile already exists. Only run 'rivet init' in empty directory."+ return Nothing+ else return $ Just $ do want ["init"]+ "init" ~> Tasks.init proj+ ("init":_) -> do putStrLn "Usage: rivet init"+ return Nothing+ _ -> do conf <- load [Required "Rivetfile"]+ commands <- (map (\(k,String v) -> (T.drop (length "commands.") k, v)) .+ filter (\(k,v) -> (T.pack "commands.") `T.isPrefixOf` k) .+ M.toList) <$> getMap conf+ deps <- lookupDefault [] conf (T.pack "dependencies")+ cabal <- lookupDefault "cabal " conf (T.pack "cabal-command")+ return $ Just $ do+ case targets of+ [] -> action $ liftIO $ putStrLn "Need a task. Run `rivet tasks` to see all tasks."+ ("test":_) -> want ["test"]+ ("db:new":_:[]) -> want ["db:new"]+ ("db:new":_) -> action $ liftIO (putStrLn "usage: rivet db:new migration_name")+ ("model:new":[]) -> action $ liftIO (putStrLn "usage: rivet model:new ModelName [field_name:field_type]*")+ ("model:new":_) -> want ["model:new"]+ ("db:migrate":_:[]) -> want ["db:migrate"]+ ("db:migrate":_:_) -> action $ liftIO (putStrLn "usage: rivet db:migrate [env]")+ ("db:migrate:down":_:[]) -> want ["db:migrate:down"]+ ("db:migrate:down":_:_) -> action $ liftIO (putStrLn "usage: rivet db:migrate:down [env]")+ ("db:status":_:[]) -> want ["db:status"]+ ("db:status":_:_) -> action $ liftIO (putStrLn "usage: rivet db:status [env]")+ (target:args) ->+ do mapM_ (\t ->+ if taskName t == target+ then if length args == taskNumArgs t+ then want [taskName t]+ else action $ liftIO (putStrLn $+ "usage: rivet " +++ taskName t ++ " " +++ taskUsage t)+ else return ())+ tasks+ when (not (target `elem` (map taskName tasks))) $ want targets+ Rules.addCommands commands+ Rules.addDependencies cabal deps+ Rules.addBinary cabal proj+ mapM_ (\t -> taskName t ~> taskBody t proj conf (tail targets)) tasks+ "cabal.sandbox.config" *> \_ -> cmd "cabal sandbox init"+ "run" ~> Tasks.run proj+ "test" ~> Tasks.test cabal targets+ "db" ~> Tasks.db proj conf+ "db:test" ~> Tasks.dbTest proj conf+ "db:create" ~> Tasks.dbCreate proj conf+ "db:new" ~> Tasks.dbNew targets+ "db:migrate" ~> Tasks.dbMigrate cabal proj conf (tail targets)+ "db:migrate:down" ~> Tasks.dbMigrateDown cabal proj conf (tail targets)+ "db:status" ~> Tasks.dbStatus cabal proj conf (tail targets)+ "repl" ~> Tasks.repl cabal+ "setup" ~> Tasks.setup cabal+ "crypt:edit" ~> Tasks.cryptEdit proj+ "crypt:show" ~> Tasks.cryptShow+ "crypt:setpass" ~> Tasks.cryptSetPass proj++ "tasks" ~> liftIO (mapM_ (putStrLn . ("rivet " ++)) $+ ["init"+ ,"run"+ ,"test [pattern]"+ ,"db"+ ,"db:test"+ ,"db:create"+ ,"db:new migration_name"+ ,"db:migrate"+ ,"db:migrate:down"+ ,"db:status"+ ,"model:new ModelName"+ ,"repl"+ ,"setup"+ ] ++ map taskName tasks)
+ src/Rivet/Rules.hs view
@@ -0,0 +1,69 @@+module Rivet.Rules where++import Prelude hiding ((*>), (++))++import Control.Monad (void, when)+import Data.List (isInfixOf)+import qualified Data.Text as T+import Development.Shake++import Rivet.Common++addCommands commands =+ sequence_ (map (\(cName, cCom) -> (T.unpack cName) ~> void (exec (T.unpack cCom)))+ commands)++addBinary cabal proj =+ do let binary = "./.cabal-sandbox/bin/" ++ proj+ binary *> \_ -> do files <- getDirectoryFiles "" ["src/Main.hs", "*.cabal"]+ need files+ cmd $ cabal ++ " install -j -fdevelopment --reorder-goals --force-reinstalls"++addDependencies cabal deps =+ do let depDirs = map ((++ ".d/.rivetclone") . ("deps/" ++) . T.unpack . head .+ T.splitOn (T.pack ":") . head . T.splitOn (T.pack "+")) deps+ sequence_ (map (\d ->+ do let (repo':rest) = T.splitOn (T.pack "+") d+ let (repo:branchspec) = T.splitOn (T.pack ":") repo'+ let depdir = ("deps/" ++ (T.unpack repo) ++ ".d")+ depdir ++ "/.rivetclone" *> \clonedFile -> do+ liftIO $ removeFiles depdir ["//*"]+ () <- case branchspec of+ (branch:_) -> cmd ("git clone --depth=1 -b " ++ (T.unpack branch) +++ " https://github.com/" ++ (T.unpack repo) ++ " " +++ depdir)+ _ -> cmd ("git clone --depth=1 https://github.com/"+ ++ (T.unpack repo) ++ " " ++ depdir)+ writeFile' clonedFile ""+ let addSource s = do contents <- readFileOrBlank "deps/add-all"+ let addstr = cabal ++ " sandbox add-source " ++ s+ if addstr `isInfixOf` contents+ then return ()+ else liftIO $ appendFile "deps/add-all" (addstr ++ "\n")+ let remstr = cabal ++ " sandbox delete-source " ++ s+ if remstr `isInfixOf` contents+ then return ()+ else liftIO $ appendFile "deps/delete-all" (remstr ++ "\n")+ -- NOTE(dbp 2015-01-06): This is an imperfect test, but one that is+ -- easy to mock up, if your sandbox is structured differently.+ hasSandbox <- doesFileExist "cabal.sandbox.config"+ if hasSandbox+ then cmd addstr :: Action ()+ else return ()+ hasHalcyon <- doesDirectoryExist ".halcyon"+ when hasHalcyon $+ do contents <- readFileOrBlank ".halcyon/sandbox-sources"+ if s `isInfixOf` contents+ then return ()+ else liftIO $ appendFile ".halcyon/sandbox-sources" (s ++ "\n")++ case rest of+ (subdirs:_) -> mapM_ (\subdir -> addSource (depdir ++ "/" ++ (T.unpack subdir)))+ (T.splitOn (T.pack ",") subdirs)+ _ -> addSource depdir)+ deps)+ "deps" ~> need depDirs+ where readFileOrBlank nm = do e <- doesFileExist nm+ if e+ then liftIO $ readFile nm+ else return ""
+ src/Rivet/TH.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE TemplateHaskell #-}+module Rivet.TH where++import qualified Data.Foldable as F+import Data.List+import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import System.Directory.Tree+import System.FilePath++type FileData = (String, String)+type DirData = FilePath++loadFile :: String -> FilePath -> Q [Dec]+loadFile nm pth = do let ident = mkName nm+ typeSig <- SigD ident `fmap` [t| String |]+ v <- valD (varP ident) (normalB $ lift =<< runIO (readFile pth)) []+ return [typeSig, v]++loadProjectTemplate :: Q [Dec]+loadProjectTemplate = do let dir = mkName "tDirTemplate"+ typeSig <- SigD dir `fmap` [t| ([String], [(String, String)]) |]+ v <- valD (varP dir) (normalB $ dirQ ("template" </> "project")) []+ return [typeSig, v]++loadModelTemplate :: Q [Dec]+loadModelTemplate = do let dir = mkName "tModelTemplate"+ typeSig <- SigD dir `fmap` [t| ([String], [(String, String)]) |]+ v <- valD (varP dir) (normalB $ dirQ ("template" </> "model")) []+ return [typeSig, v]++-- NOTE(dbp 2014-09-27): Much of this code is derived from that used+-- in the Snap project starter.+------------------------------------------------------------------------------+-- Gets all the directories in a DirTree+--+getDirs :: [FilePath] -> DirTree a -> [FilePath]+getDirs prefix (Dir n c) = (intercalate "/" (reverse (n:prefix))) :+ concatMap (getDirs (n:prefix)) c+getDirs _ (File _ _) = []+getDirs _ (Failed _ _) = []++------------------------------------------------------------------------------+-- Reads a directory and returns a tuple of the list of all directories+-- encountered and a list of filenames and content strings.+--+readTree :: FilePath -> IO ([DirData], [FileData])+readTree dir = do d <- readDirectory $ dir </> "."+ let ps = zipPaths $ "" :/ (dirTree d)+ fd = F.foldr (:) [] ps+ dirs = getDirs [] $ dirTree d+ return (drop 1 dirs, fd)+------------------------------------------------------------------------------+-- Calls readTree and returns its value in a quasiquote.+--+dirQ :: FilePath -> Q Exp+dirQ tplDir = do d <- runIO . readTree $ tplDir+ lift d
+ src/Rivet/Tasks.hs view
@@ -0,0 +1,253 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Rivet.Tasks where+++import Control.Applicative ((<$>))+import Control.Arrow+import Control.Monad (filterM, void, when)+import Data.Char (isSpace)+import Data.Char+import Data.Configurator+import Data.Configurator.Types+import qualified Data.HashMap.Strict as M+import Data.List (intercalate, intersperse,+ isInfixOf, isSuffixOf, sort)+import Data.Maybe (fromMaybe)+import Data.Monoid+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time.Clock+import Data.Time.Format+import Database.PostgreSQL.Simple+import Development.Shake hiding (createDirectory',+ doesDirectoryExist,+ getDirectoryContents, writeFile')+import Prelude hiding ((++))+import System.Console.GetOpt+import System.Directory (copyFile, createDirectory,+ createDirectoryIfMissing,+ doesDirectoryExist,+ getCurrentDirectory,+ getDirectoryContents,+ getTemporaryDirectory, removeFile)+import System.Environment (lookupEnv)+import System.Exit+import System.Exit+import System.FilePath+import System.IO+import System.Process++import Rivet.Common+import Rivet.TH++createDirectory' d = do putStrLn $ "creating " ++ d+ createDirectory d+writeFile' f c = do putStrLn $ "writing " ++ f+ writeFile f c++-- NOTE(dbp 2014-09-27): These calls load in files from disk using TH.+loadProjectTemplate+loadFile "migrationTemplate" "template/migration.hs"++init projName = do liftIO $ do mapM createDirectory' (fst tDirTemplate)+ mapM_ write (snd tDirTemplate)+ hasGit <- liftIO $ doesDirectoryExist ".git"+ if hasGit+ then liftIO $ putStrLn "detected existing .git directory, not committing."+ else do void $ exec "git init"+ void $ exec "git add ."+ void $ exec "git commit -m 'initial commit'"+ where write (f,c) =+ if isSuffixOf "project.cabal" f+ then writeFile' (projName ++ ".cabal") (insertProjName c)+ else writeFile' f (replace "PROJECT" (dbIfy projName) c)+ isNameChar c = isAlphaNum c || c == '-'+ insertProjName c = replace "project" (filter isNameChar projName) c++replace old new s = T.unpack . T.replace (T.pack old) (T.pack new) $ T.pack s++-- NOTE(dbp 2014-09-18): Tasks follow+run proj =+ do let binary = "./.cabal-sandbox/bin/" ++ proj+ need [binary]+ void $ exec binary++dbIfy = T.unpack . T.replace "-" "_" . T.pack++db proj conf = do pass <- liftIO $ require conf (T.pack "database-password")+ port <- liftIO $ lookupDefault 5432 conf (T.pack "database-port") :: Action Int+ user <- liftIO $ lookupDefault (dbIfy proj ++ "_user") conf (T.pack "database-user")+ let c = "PGPASSWORD=" ++ pass ++ " psql -hlocalhost " ++ dbIfy proj+ ++ "_devel -U" ++ user ++ " -p " ++ show port+ void $ exec c++dbTest proj conf =+ do pass <- liftIO $ require conf (T.pack "database-password")+ port <- liftIO $ lookupDefault 5432 conf (T.pack "database-port") :: Action Int+ user <- liftIO $ lookupDefault (dbIfy proj ++ "_user") conf (T.pack "database-user")+ let c = "PGPASSWORD=" ++ pass ++ " psql " ++ dbIfy proj+ ++ "_test -U" ++ user ++ " -hlocalhost" ++ " -p " ++ show port+ void $ exec c++test cabal targets =+ do code <- exec $ cabal ++ " exec -- runghc -isrc -ispec spec/Main.hs -m \"" ++ (intercalate " " (tail targets) ++ "\"")+ case code of+ ExitSuccess -> return ()+ _ -> error "rivet test: Test Failure."++dbCreate proj conf =+ do pass <- liftIO $ require conf (T.pack "database-password")+ user <- liftIO $ lookupDefault (dbIfy proj ++ "_user") conf (T.pack "database-user")+ let dbname = dbIfy proj+ code <- exec $ "PGPASSWORD=" ++ pass ++ " psql -hlocalhost -U" ++ user ++ " template1 -c 'SELECT 1'"+ isSuper <- case code of+ ExitFailure _ -> do void $ exec $ "psql template1 -c \"CREATE USER " ++ user ++ " WITH SUPERUSER PASSWORD '" ++ pass ++ "'\""+ return True+ ExitSuccess -> do res <- readExec $ "psql -hlocalhost -U" ++ user ++ " template1 -c \"SELECT current_setting('is_superuser')\""+ return ("on" `isInfixOf` res)+ if isSuper+ then do exec $ "PGPASSWORD=" ++ pass ++ " psql -hlocalhost -U" ++ user ++ " template1 -c \"CREATE DATABASE " ++ dbname ++ "_devel\""+ exec $ "PGPASSWORD=" ++ pass ++ " psql -hlocalhost -U" ++ user ++ " template1 -c \"CREATE DATABASE " ++ dbname ++ "_test\""+ return ()+ else do void $ exec $ "psql template1 -c \"CREATE DATABASE " ++ dbname ++ "_devel\""+ void $ exec $ "psql template1 -c \"CREATE DATABASE " ++ dbname ++ "_test\""+ void $ exec $ "psql template1 -c \"GRANT ALL ON DATABASE " ++ dbname ++ "_devel TO " ++ user ++ "\""+ void $ exec $ "psql template1 -c \"GRANT ALL ON DATABASE " ++ dbname ++ "_test TO " ++ user ++ "\""++dbNew targets =+ do let name = head (tail targets)+ liftIO $ genMigration name sqlud+ where sqlud = "sql up down\n\n\+ \up = \"\"\n\+ \\n\+ \down = \"\""++genMigration name content =+ do now <- getCurrentTime+ let modname = (formatTime defaultTimeLocale "M%Y%m%d%H%M%S_" now) ++ name+ str = modname ++ ".hs"+ putStrLn $ "Writing to migrations/" ++ str ++ "..."+ writeFile ("migrations/" ++ str)+ (replace "MIGRATION_MODULE" modname . replace "CONTENT" content $ migrationTemplate)++data MigrateMode = Up | Down | Status deriving Show++dbMigrate cabal proj conf [] =+ do liftIO $ migrate cabal proj conf "devel" Up+ liftIO $ migrate cabal proj conf "test" Up+dbMigrate cabal proj conf (env:_) = liftIO $ migrate cabal proj conf env Up++dbMigrateDown cabal proj conf [] =+ do liftIO $ migrate cabal proj conf "devel" Down+ liftIO $ migrate cabal proj conf "test" Down+dbMigrateDown cabal proj conf (env:_) = liftIO $ migrate cabal proj conf env Down++dbStatus cabal proj conf [] = do liftIO $ migrate cabal proj conf "devel" Status+ liftIO $ migrate cabal proj conf "test" Status+dbStatus cabal proj conf (env:_) = liftIO $ migrate cabal proj conf env Status++migrate cabal proj conf env mode =+ do dbuser <- lookupDefault (dbIfy proj ++ "_user") conf "database-user"+ dbpass <- require conf "database-password"+ dbhost <- lookupDefault "127.0.0.1" conf "database-host"+ dbport <- lookupDefault 5432 conf "database-port"+ dbname <- lookupDefault (dbIfy proj ++ "_" ++ env) conf "database-name"+ c <- connect (ConnectInfo dbhost dbport dbuser dbpass dbname)+ execute_ c "CREATE TABLE IF NOT EXISTS migrations (name text NOT NULL PRIMARY KEY, run_at timestamptz NOT NULL DEFAULT now())"+ tmp <- getTemporaryDirectory+ now <- getCurrentTime+ let main = tmp ++ "/migrate_" ++ formatTime defaultTimeLocale "%Y%m%d%H%M%S_" now ++ env ++ ".hs"+ migrations <- sort . map stripSuffix . filter isCode <$>+ getDirectoryContents "migrations"+ run <- case mode of+ Up ->+ do missing <- filterM (notExists c) migrations+ if null missing+ then putStrLn "No migrations to run." >> return False+ else do putStrLn $ "Writing migration script to " ++ main ++ "..."+ writeFile main $+ "import Database.PostgreSQL.Simple\nimport Rivet.Migration\n" +++ (unlines $ map createImport missing) +++ "\nmain = do\n" +++ (formatconnect dbhost dbport dbuser dbpass dbname) +++ (unlines $ map (createRun mode) missing)+ return True+ Down -> do toDown <- dropWhileM (notExists c) $ reverse migrations+ case toDown of+ (x:_) -> do putStrLn $ "Writing migration script to " ++ main ++ "..."+ writeFile main $+ "import Database.PostgreSQL.Simple\nimport Rivet.Migration\n" +++ createImport x +++ "\nmain = do\n" +++ (formatconnect dbhost dbport dbuser dbpass dbname) +++ createRun mode x+ return True+ _ -> putStrLn "No migrations remaining." >> return False+ Status -> do mapM_ (\m -> do ne <- notExists c m+ if ne+ then putStrLn $ m ++ " in " ++ env+ else putStrLn $ " APPLIED " ++ m ++ " in " ++ env)+ migrations+ return False+ when run $ do putStrLn $ "Running " ++ main ++ "..."+ system $ cabal ++ " exec -- runghc -isrc -imigrations " ++ main+ putStrLn $ "Cleaning up... "+ removeFile main+ where stripSuffix = reverse . drop 3 . reverse+ isCode = isSuffixOf ".hs"+ dropWhileM :: Monad m => (a -> m Bool) -> [a] -> m [a]+ dropWhileM f [] = return []+ dropWhileM f (x:xs) = do r <- f x+ if r+ then dropWhileM f xs+ else return (x:xs)+ notExists c m =+ null <$> liftIO (getMigration c m)+ getMigration :: Connection -> String -> IO [(Only String)]+ getMigration c m = query c "SELECT name FROM migrations WHERE name = ?" (Only m)+ createImport m = "import qualified " ++ m+ createRun mode m = " run " ++ w m ++ " c " ++ show mode ++ " " ++ m ++ ".migrate >> putStrLn \"Ran " ++ m ++ "\""+ formatconnect h p u ps nm = " c <- connect (ConnectInfo " ++ w h ++ " " ++ show p ++ " " ++ w u ++ " " ++ w ps ++ " " ++ w nm ++ ")\n"+ w s = "\"" ++ s ++ "\""++++repl cabal = void (exec $ cabal ++ " repl")++setup cabal = do need ["cabal.sandbox.config"]+ need ["deps"]+ exec $ cabal ++ " install -fdevelopment --only-dependencies --enable-tests --reorder-goals --force-reinstalls"+ exec $ cabal ++ " exec -- ghc-pkg expose hspec"+ exec $ cabal ++ " exec -- ghc-pkg expose hspec-snap"+ void $ exec $ cabal ++ " exec -- ghc-pkg hide resource-pool"++cryptEdit proj =+ do e <- doesFileExist ".rivetcrypt"+ let decrypted = "/tmp/rivetdecrypted-" ++ proj+ editor <- fromMaybe "vi" <$> liftIO (lookupEnv "EDITOR")+ if e+ then exec $ "openssl enc -aes-256-cbc -d -a -salt -in .rivetcrypt -out " ++ decrypted ++ " -pass file:.rivetpass"+ else exec $ "touch " ++ decrypted+ exec $ editor ++ " " ++ decrypted+ exec $ "openssl enc -aes-256-cbc -e -a -salt -in " ++ decrypted ++ " -out .rivetcrypt -pass file:.rivetpass"+ void $ exec $ "rm " ++ decrypted++cryptShow =+ do e <- doesFileExist ".rivetcrypt"+ if e+ then void $ exec $ "openssl enc -aes-256-cbc -d -a -salt -in .rivetcrypt -pass file:.rivetpass"+ else liftIO $ putStrLn "No .rivetcrypt."++cryptSetPass proj =+ do e <- doesFileExist ".rivetcrypt"+ let decrypted = "/tmp/rivetdecrypted-" ++ proj+ liftIO $ putStrLn "Enter new passphrase (will be stored in .rivetpass):"+ pass <- liftIO getLine+ if e+ then exec $ "openssl enc -aes-256-cbc -d -a -salt -in .rivetcrypt -out " ++ decrypted ++ " -pass file:.rivetpass"+ else exec $ "touch " ++ decrypted+ liftIO $ copyFile ".rivetpass" ".rivetpass-0"+ liftIO $ writeFile ".rivetpass" pass+ exec $ "openssl enc -aes-256-cbc -e -a -salt -in " ++ decrypted ++ " -out .rivetcrypt -pass file:.rivetpass"+ void $ exec $ "rm " ++ decrypted