packages feed

bake (empty) → 0.0

raw patch · 16 files changed

+452/−0 lines, 16 filesdep +basedep +cmdargsdep +shakesetup-changed

Dependencies added: base, cmdargs, shake

Files

+ CHANGES.txt view
@@ -0,0 +1,3 @@+Changelog for Bake++    Initial version, not ready for public use
+ Development/Bake.hs view
@@ -0,0 +1,22 @@+
+-- | Define a continuous integration system.
+module Development.Bake(
+    -- * Execute
+    bake,
+    -- * Central types
+    Candidate(..), Oven(..), TestInfo,
+    defaultOven, run,
+    -- ** TestInfo mutators
+    threads, threadsAll, before, beforeClear, require,
+    -- * Operations
+    startServer, startClient,
+    module Development.Bake.Send,
+    -- * Utility types
+    Host, Port
+    ) where
+
+import Development.Bake.Type
+import Development.Bake.Server.Start
+import Development.Bake.Client
+import Development.Bake.Args
+import Development.Bake.Send
+ Development/Bake/Args.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE RecordWildCards, DeriveDataTypeable #-}
+{-# OPTIONS_GHC -fno-warn-missing-fields #-}
+
+-- | Define a continuous integration system.
+module Development.Bake.Args(
+    bake
+    ) where
+
+import System.Console.CmdArgs
+import Development.Bake.Type
+import Development.Bake.Client
+import Development.Bake.Server.Start
+import Development.Bake.Send
+
+
+type HostPort = String
+
+data Bake
+    = Server {port :: Port, author :: Author, name :: String}
+    | Client {server :: HostPort, author :: Author, name :: String, threads :: Int, provide :: [String]}
+    | AddPatch {server :: HostPort, author :: Author, name :: String}
+    | DelPatch {server :: HostPort, author :: Author, name :: String}
+    | DelPatches {server :: HostPort, author :: Author}
+    | Pause {server :: HostPort, author :: Author}
+    | Unpause {server :: HostPort, author :: Author}
+    | Run {output :: FilePath, test :: String, state :: String, patch :: [String]}
+      deriving (Typeable,Data)
+
+
+bakeMode = cmdArgsMode $ modes
+    [Server{port = 80, author = "unknown"}
+    ,Client{server = "", name = "", threads = 0, provide = []}
+    ,AddPatch{}
+    ,DelPatch{}
+    ,DelPatches{}
+    ,Pause{}
+    ,Unpause{}
+    ,Run "" "" "" []
+    ]
+
+bake :: (Show state, Read state, Show patch, Read patch, Show test, Read test)
+     => Oven state patch test -> IO ()
+bake oven = do
+    x <- cmdArgsRun bakeMode
+    case x of
+        Server{..} -> startServer port author name oven
+        Client{..} -> startClient (hp server) author name provide threads
+        AddPatch{..} -> sendAddPatch (hp server) author name
+        DelPatch{..} -> sendDelPatch (hp server) author name
+        DelPatches{..} -> sendDelAllPatches (hp server) author
+        Pause{..} -> sendPause (hp server) author
+        Unpause{..} -> sendUnpause (hp server) author
+        Run{..} -> do
+            let TestInfo{..} = ovenRunTest oven (Candidate (read state) (map read patch)) (read test)
+            writeFile output . show =<< testAction
+    where
+        hp "" = ovenDefaultServer oven
+        hp s = (h, read $ drop 1 p)
+            where (h,p) = break (== ':') s
+ Development/Bake/Client.hs view
@@ -0,0 +1,32 @@+
+-- | Define a continuous integration system.
+module Development.Bake.Client(
+    startClient
+    ) where
+
+import Development.Bake.Type
+import Development.Bake.Util
+import Development.Bake.Message
+import System.Exit
+import Development.Shake.Command
+import Control.Concurrent
+import Control.Monad
+
+
+-- given server, name, threads
+startClient :: (Host,Port) -> Author -> String -> [String] -> Int -> IO ()
+startClient hp author name provides threads = do
+    cookie <- newCookie
+
+    let process xs = do
+            forM_ xs $ \(Reply can test) -> forkIO $ withTempFile "bake.txt" $ \file -> do
+                (time, (exit, Stdout stdout)) <- timed $ cmd "self" (("--output=" ++ file):undefined)
+                info <- case exit of
+                    ExitFailure i -> return $ Left i
+                    ExitSuccess -> fmap (Right . map Test . lines) $ readFile file
+                sendMessage hp $ Finished can cookie test stdout time info
+                ping
+
+        ping = process =<< sendMessage hp (Ping author name cookie provides threads)
+
+    forever $ ping >> sleep 60
+ Development/Bake/Email.hs view
@@ -0,0 +1,8 @@+
+module Development.Bake.Email(ovenEmail) where
+
+import Development.Bake.Type
+
+
+ovenEmail :: (Host,Port) -> Oven state patch test -> Oven state (patch, [String]) test
+ovenEmail = undefined
+ Development/Bake/Git.hs view
@@ -0,0 +1,11 @@+
+module Development.Bake.Git(SHA1, ovenGit) where
+
+import Development.Bake.Type
+
+newtype SHA1 = SHA1 String deriving (Read,Show)
+
+
+-- | Given a repo name, and a set of tests, produce something that runs from git
+ovenGit :: String -> String -> Oven SHA1 SHA1 test -> Oven SHA1 SHA1 test
+ovenGit repo branch = undefined
+ Development/Bake/Message.hs view
@@ -0,0 +1,35 @@+
+-- | Define a continuous integration system.
+module Development.Bake.Message(
+    Message(..), Reply(..), sendMessage, fromPayload
+    ) where
+
+import Development.Bake.Type
+import Development.Bake.Web
+
+data Message
+    -- Send by the user
+    = AddPatch Author Patch
+    | DelPatch Author Patch
+    | DelAllPatches Author
+    | Pause Author
+    | Unpause Author
+    -- Sent by the client
+    | Ping Author String String [String] Int -- name, cookie, provides, threads
+    | Finished (Candidate State Patch) String (Maybe Test) String Double (Either Int [Test])
+                                       -- stdout time   result
+
+data Reply = Reply (Candidate State Patch) (Maybe Test)
+
+toPayload :: Message -> Payload
+toPayload = undefined
+
+
+fromPayload :: Payload -> Message
+fromPayload = undefined
+
+
+sendMessage :: (Host,Port) -> Message -> IO [Reply]
+sendMessage hp msg = do
+    send hp $ toPayload msg
+    return []
+ Development/Bake/Send.hs view
@@ -0,0 +1,24 @@+
+module Development.Bake.Send(
+    sendPause, sendUnpause,
+    sendAddPatch, sendDelPatch, sendDelAllPatches
+    ) where
+
+import Control.Monad
+import Development.Bake.Type
+import Development.Bake.Message
+
+sendPause :: (Host,Port) -> Author -> IO ()
+sendPause hp author = void $ sendMessage hp $ Pause author
+
+sendUnpause :: (Host,Port) -> Author -> IO ()
+sendUnpause hp author = void $ sendMessage hp $ Unpause author
+
+sendAddPatch :: Show patch => (Host,Port) -> Author -> patch -> IO ()
+sendAddPatch hp author x = void $ sendMessage hp $ AddPatch author $ Patch $ show x
+
+sendDelPatch :: Show patch => (Host,Port) -> Author -> patch -> IO ()
+sendDelPatch hp author x = void $ sendMessage hp $ DelPatch author $ Patch $ show x
+
+sendDelAllPatches :: (Host,Port) -> Author -> IO ()
+sendDelAllPatches hp author = void $ sendMessage hp $ DelAllPatches author
+ Development/Bake/Server/Start.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE RecordWildCards #-}
+
+-- | Define a continuous integration system.
+module Development.Bake.Server.Start(
+    startServer
+    ) where
+
+import Development.Bake.Type
+import Development.Bake.Web
+import Data.IORef
+import Development.Bake.Server.Type
+
+
+startServer :: (Show state, Read state, Show patch, Read patch, Show test, Read test)
+            => Port -> Author -> String -> Oven state patch test -> IO ()
+startServer port author name oven = do
+    s <- ovenUpdateState (concrete oven) Nothing
+    ref <- newIORef $ defaultServer s
+    server port $ \Payload{..} -> undefined
+ Development/Bake/Server/Type.hs view
@@ -0,0 +1,44 @@+
+-- | Define a continuous integration system.
+module Development.Bake.Server.Type(
+    Server(..), defaultServer, History(..), Running(..)
+    ) where
+
+import Development.Bake.Type
+
+defaultServer :: State -> Server
+defaultServer s = Server [] [] [] (Candidate s [])
+
+data Server = Server
+    {history :: [History]
+    ,running :: [Running]
+    ,alias :: [(State, Candidate State Patch)]
+    ,active :: Candidate State Patch
+    }
+
+data History = History (Candidate State Patch) (Maybe Test) FilePath Double (Either Int [TestInfo Test])
+
+data Running = Running (Candidate State Patch) (Maybe Test) Double String
+
+
+
+{-
+do
+    process $ \    = AddPatch Author Patch
+    | DelPatch Author Patch
+    | DelAllPatches Author
+    | Pause Author
+    | Unpause Author
+    -- Sent by the client
+    | Ping Author String String Int -- name, cookie, threads
+    | Finished (Candidate State Patch) (Maybe Test) String Double (Either Int [TestInfo Test])
+
+
+newtype Sever = Server
+    {history :: [History]
+    ,alias :: [(State, Candidate State Patch)]
+    ,current :: Candidate State Patch
+    ,active :: [()]
+    }
+
+-}
+ Development/Bake/Type.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE Rank2Types #-}
+
+-- | Define a continuous integration system.
+module Development.Bake.Type(
+    Host, Port,
+    Candidate(..), Oven(..), TestInfo(..), defaultOven,
+    threads, threadsAll, before, beforeClear, run, require,
+    State(..), Patch(..), Test(..), concrete,
+    Author
+    ) where
+
+type Author = String
+
+type Host = String
+
+type Port = Int
+
+data Candidate state patch = Candidate state [patch]
+
+data Oven state patch test = Oven
+    {ovenUpdateState :: Maybe (Candidate state patch) -> IO state
+        -- ^ Given a state, and a set of candiates that have passed,
+        --   merge to create a new state.
+    ,ovenRunTest :: Candidate state patch -> Maybe test -> TestInfo test
+        -- ^ Produce information about a test
+    ,ovenPatchReject :: patch -> Maybe test -> IO ()
+        -- ^ A patch has been marked as failing, tell everyone.
+    ,ovenPatchExtra :: patch -> IO String
+        -- ^ Extra information about the patch
+    ,ovenDefaultServer :: (Host, Port)
+        -- ^ Default server to use
+    }
+
+defaultOven :: Oven state patch test
+defaultOven = Oven
+    (error "defaultOven.ovenUpdateState") (error "defaultOven.ovenRunTest")
+    (\_ _ -> return ()) (\_ -> return "") ("",0)
+
+data TestInfo test = TestInfo
+    {testThreads :: Maybe Int -- number of threads, defaults to 1, Nothing for use all
+    ,testAction :: IO [test]
+    ,testBefore :: [test]
+    ,testBeforeAuto :: Bool
+    ,testRequire :: [String]
+    }
+
+require :: String -> TestInfo test -> TestInfo test
+require x t = t{testRequire=x:testRequire t}
+
+threads :: Int -> TestInfo test -> TestInfo test
+threads j t = t{testThreads=Just j}
+
+threadsAll :: TestInfo test -> TestInfo test
+threadsAll t = t{testThreads=Nothing}
+
+before :: [test] -> TestInfo test -> TestInfo test
+before xs t = t{testBefore=testBefore t++xs}
+
+beforeClear :: TestInfo test -> TestInfo test
+beforeClear t = t{testBefore=[], testBeforeAuto=False}
+
+run :: IO [test] -> TestInfo test
+run act = TestInfo (Just 1) act [] True []
+
+
+newtype State = State String
+newtype Patch = Patch String
+newtype Test = Test String
+
+concrete :: (Show state, Read state, Show patch, Read patch, Show test, Read test)
+         => Oven state patch test -> Oven State Patch Test
+concrete = undefined
+ Development/Bake/Util.hs view
@@ -0,0 +1,20 @@+
+module Development.Bake.Util(
+    sleep, newCookie, timed, withTempFile
+    ) where
+
+
+sleep :: Double -> IO ()
+sleep = undefined
+
+
+newCookie :: IO String
+newCookie = undefined
+
+
+timed :: IO a -> IO (Double, a)
+timed = undefined
+
+
+withTempFile :: String -> (FilePath -> IO ()) -> IO ()
+withTempFile = undefined
+ Development/Bake/Web.hs view
@@ -0,0 +1,20 @@+
+module Development.Bake.Web(
+    Payload(..), send, server
+    ) where
+
+import Development.Bake.Type
+
+
+data Payload = Payload
+    {payloadURL :: String
+    ,payloadArgs :: [(String, String)]
+    ,payloadBody :: String
+    }
+
+send :: (Host,Port) -> Payload -> IO String
+send = undefined
+
+
+server :: Port -> (Payload -> IO (Either FilePath String)) -> IO ()
+server = undefined
+ LICENSE view
@@ -0,0 +1,34 @@+Copyright Neil Mitchell 2014.+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 Neil Mitchell 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.+++Some of the JavaScript files in html/ have different copyright and licenses.+Please consult the corresponding source file in js-src/
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bake.cabal view
@@ -0,0 +1,47 @@+cabal-version:      >= 1.10+build-type:         Simple+name:               bake+version:            0.0+license:            BSD3+license-file:       LICENSE+category:           Development+author:             Neil Mitchell <ndmitchell@gmail.com>+maintainer:         Neil Mitchell <ndmitchell@gmail.com>+copyright:          Neil Mitchell 2014+synopsis:           Continuous integration library.+description:+    Used for large scale continuous integration.+    NOT READY FOR USE BY ANYONE - HALF THE FUNCTIONS ARE UNDEFINED!+homepage:           https://github.com/ndmitchell/bake#readme+bug-reports:        https://github.com/ndmitchell/bake/issues+tested-with:        GHC==7.8.2, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2++extra-source-files:+    CHANGES.txt++source-repository head+    type:     git+    location: https://github.com/ndmitchell/bake.git++library+    default-language: Haskell2010+    build-depends:+        base == 4.*,+        cmdargs >= 0.10,+        shake >= 0.10++    exposed-modules:+        Development.Bake+        Development.Bake.Git+        Development.Bake.Email++    other-modules:+        Development.Bake.Args+        Development.Bake.Client+        Development.Bake.Message+        Development.Bake.Send+        Development.Bake.Server.Start+        Development.Bake.Server.Type+        Development.Bake.Type+        Development.Bake.Util+        Development.Bake.Web