hsfcsh (empty) → 0.0.1
raw patch · 8 files changed
+400/−0 lines, 8 filesdep +basedep +hdaemonizedep +hsloggersetup-changed
Dependencies added: base, hdaemonize, hslogger, network, process
Files
- LICENSE +30/−0
- README +30/−0
- Setup.hs +2/−0
- example/Main.as +19/−0
- example/Makefile +4/−0
- hsfcsh.cabal +36/−0
- hsfcsh.hs +144/−0
- hsfcsh_do.hs +135/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Yuras Shumovich++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 Yuras Shumovich 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.
+ README view
@@ -0,0 +1,30 @@++It is just a wrapper around fcsh. It allows to build flash/flex projects incrementally.+It can be used from Makefile.++The package contains two executables, hsfcsh and hsfcsh_do. The first one is daemon,+hsfcsh_do allows to send commands to the daemon.+++Install++- Install flex sdk and add <flex_sdk>/bin to your PATH+- Install haskell platform, add ~/.cabal/bin to your PATH+- `cabal install hsfcsh`+++Using++Use `hsfcsh_do spawn` or `hsfcsh_do exit` to start or stop the daemon.+Use `hsfcsh_do compile args` to compile something. It will spawn the daemon if it is not started yet.++The next example will compile Start.mxml from the current directory:+ hsfcsh_do compile -- "$(PWD)/Start.mxml"++The first time it may take few minutes to compile for large projects, but then it will compile+the project incrementally.++You can use hsfcsh_do from Makefile. See example in the corresponding directory.+It will redirect compiler output to the stdout, so you could examine the results (errors, warnings, etc)+or let your editor (vim, emacs) to parse them.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ example/Main.as view
@@ -0,0 +1,19 @@++package+{++import flash.display.Sprite;+import flash.text.TextField;++public class Main extends Sprite+{+ public function Main()+ {+ var txt : TextField = new TextField();+ txt.text = "Hello World";+ addChild(txt);+ }+}++}+
+ example/Makefile view
@@ -0,0 +1,4 @@++all:+ hsfcsh_do compile -- "-use-network=true -static-link-runtime-shared-libraries $(PWD)/Main.as"+
+ hsfcsh.cabal view
@@ -0,0 +1,36 @@+Name: hsfcsh+Version: 0.0.1+Synopsis: Incremental builder for flash+Description: It is a wrapper around fcsh. It allows to build flash/flex project incrementally. Can be used from Makefile+Homepage: https://github.com/Yuras/hsfcsh+License: BSD3+License-file: LICENSE+Author: Yuras Shumovich+Maintainer: shumovichy@gmail.com+Category: Development+Build-type: Simple+Extra-source-files:+ README,+ example/Main.as,+ example/Makefile+Cabal-version: >=1.6+Executable hsfcsh+ Main-is: hsfcsh.hs+ Build-depends:+ base == 4.*,+ hslogger == 1.1.*,+ hdaemonize == 0.4.*,+ process == 1.*,+ network == 2.*+Executable hsfcsh_do+ Main-is: hsfcsh_do.hs+ Build-depends:+ base < 5,+ hslogger,+ hdaemonize,+ process,+ network++Source-repository head+ Type: git+ Location: git@github.com:Yuras/hsfcsh.git
+ hsfcsh.hs view
@@ -0,0 +1,144 @@+module Main+(+main+)+where++import Prelude hiding (catch)+import Network+import System.Exit+import System.IO+import System.Process+import System.Environment+import System.Posix.Daemonize+import System.Log.Logger+import System.Log.Handler.Syslog+import System.Console.GetOpt+import Control.Exception+import Control.Monad+import Control.Concurrent+import Control.Concurrent.Chan+import Data.Maybe++data Options = Options {+ optFcshCmd :: String,+ optPort :: PortNumber,+ optDaemonize :: Bool,+ optSyslog :: Bool+} deriving Show++defaultOptions = Options {+ optFcshCmd = "fcsh",+ optPort = 1234,+ optDaemonize = True,+ optSyslog = True+}++options :: [OptDescr (Options -> Options)]+options = [+ Option ['c'] ["with-fcsh"] (ReqArg (\o opts -> opts {optFcshCmd = o}) "CMD") "fcsh command",+ Option ['p'] ["port"] (ReqArg (\o opts -> opts {optPort = fromIntegral $ read o}) "PORT") "port to listen on",+ Option ['f'] ["foreground"] (NoArg (\opts -> opts {optDaemonize = False})) "don't daemonize",+ Option ['d'] ["daemonize"] (NoArg (\opts -> opts {optDaemonize = True})) "daemonize",+ Option ['s'] ["silent"] (NoArg (\opts -> opts {optSyslog = False})) "don't log to the syslog",+ Option ['v'] ["verbose"] (NoArg (\opts -> opts {optSyslog = True})) "log to the syslog"+ ]++log_ :: String+log_ = "hsfcsh"++parseOpts :: [String] -> IO (Options, [String])+parseOpts argv =+ case getOpt Permute options argv of+ (o, n, []) -> return (foldl (flip id) defaultOptions o, n)+ (_, _, errs) -> ioError (userError $ concat errs ++ usageInfo header options)+ where+ header = "Usage: hsfcsh [OPTION...]"++main :: IO ()+main = do+ (opts, _) <- getArgs >>= parseOpts+ (if optDaemonize opts then daemonize else id) $ do+ updateGlobalLogger rootLoggerName (setLevel INFO)+ s <- openlog "hsfcsh" [PID] USER DEBUG+ when (optSyslog opts) $ updateGlobalLogger rootLoggerName (setHandlers [s])+ infoM log_ "started"+ fcsh <- runInteractiveCommand $ optFcshCmd opts++ threadId <- myThreadId+ chan <- newChan+ forkIO $ reader (getOut fcsh) chan threadId+ forkIO $ reader (getErr fcsh) chan threadId++ waitReady chan Nothing++ withSocketsDo $ main' opts fcsh chan+ terminateProcess $ getPH fcsh+ infoM log_ "shutdown"++mPutStrLn :: Maybe Handle -> String -> IO ()+mPutStrLn Nothing _ = return ()+mPutStrLn (Just handle) str = hPutStrLn handle str >> hFlush handle++waitReady :: Chan Char -> Maybe Handle -> IO ()+waitReady chan handle = waitReady' []+ where+ waitReady' cs = do+ c <- readChan chan+ if c == '\n'+ then mPutStrLn handle (reverse cs) >> waitReady' []+ else if (c:cs) == " )hscf("+ then mPutStrLn handle "<FCSH END>"+ else waitReady' (c:cs)++main' :: Options -> FCSH -> Chan Char -> IO ()+main' opts fcsh chan = do+ sock <- listenOn (PortNumber $ optPort opts)+ acceptLoop fcsh sock chan+ sClose sock++type FCSH = (Handle, Handle, Handle, ProcessHandle)++getIn :: FCSH -> Handle+getIn (i, _, _, _) = i++getOut :: FCSH -> Handle+getOut (_, o, _, _) = o++getErr :: FCSH -> Handle+getErr (_, _, e, _) = e++getPH :: FCSH -> ProcessHandle+getPH (_, _, _, p) = p++acceptLoop :: FCSH -> Socket -> Chan Char -> IO ()+acceptLoop fcsh sock chan = do+ (handle, host, _) <- accept sock+ infoM log_ $ "accept from " ++ host+ hSetBinaryMode handle False+ hSetNewlineMode handle universalNewlineMode+ cont <- catch (serve fcsh handle chan) (\e -> warningM log_ (show (e :: SomeException)) >> return True)+ hClose handle+ when cont $ acceptLoop fcsh sock chan++serve :: FCSH -> Handle -> Chan Char -> IO Bool+serve fcsh handle chan = do+ cmd <- hGetLine handle+ case cmd of+ "q" -> return False+ "t" -> do+ tgt <- hGetLine handle+ debugM log_ $ "command: " ++ tgt+ hPutStrLn (getIn fcsh) $ tgt+ hFlush (getIn fcsh)+ waitReady chan (Just handle)+ serve fcsh handle chan+ "n" -> debugM log_ "NOP" >> return True+ _ -> warningM log_ ("unknown command :" ++ cmd) >> return True++reader :: Handle -> Chan Char -> ThreadId -> IO ()+reader handle chan mainThread = do+ hSetBinaryMode handle False+ let lp h = catch (hGetChar h) (\e -> errorM log_ (show (e :: SomeException)) >> killThread mainThread >> undefined) >>= writeChan chan >> lp h+ lp handle+
+ hsfcsh_do.hs view
@@ -0,0 +1,135 @@+module Main+(+main+)+where++import Prelude hiding (catch)+import Network+import System.IO+import System.Process+import System.Environment+import System.Console.GetOpt+import Control.Monad+import Control.Exception+import Control.Concurrent+import Data.Maybe+import Data.Char++data Options = Options {+ optHsfcsh :: String,+ optPort :: PortNumber+} deriving Show++defaultOptions = Options {+ optHsfcsh = "hsfcsh",+ optPort = 1234+}++options :: [OptDescr (Options -> Options)]+options = [+ Option ['c'] ["with-hsfcsh"] (ReqArg (\o opts -> opts {optHsfcsh = o}) "CMD") "hsfcsh command",+ Option ['p'] ["port"] (ReqArg (\o opts -> opts {optPort = fromIntegral $ read o}) "PORT") "port to cennect to"+ ]++parseOpts :: [String] -> IO (Options, [String])+parseOpts argv =+ case getOpt Permute options argv of+ (o, n, []) -> return (foldl (flip id) defaultOptions o, n)+ (_, _, errs) -> ioError (userError $ concat errs ++ usageInfo header options)++header :: String+header = "Usage: hsfcsh_do [OPTION...] (spawn | exit | compile \"ARGS\")"++main :: IO ()+main = withSocketsDo main'++main' = do+ args <- getArgs+ (opts, args) <- parseOpts args+ case length args of+ 1 -> case head args of+ "spawn" -> spawn (optHsfcsh opts)+ "exit" -> do+ h <- connect (optPort opts)+ let handle = fromJust h+ when (isJust h) $ hPutStrLn handle "q" >> hFlush handle >> hClose handle+ _ -> putStrLn $ usageInfo header options+ 2 -> case head args of+ "compile" -> do+ handle <- connectOrSpawn (optHsfcsh opts) (optPort opts)+ let tgt = args!!1+ id <- findId handle tgt+ let id' = fromJust id+ if isNothing id+ then do+ putStrLn "id not found, will assing"+ hPutStr handle $ "t\nmxmlc " ++ tgt ++ "\n"+ hFlush handle+ else do+ putStrLn $ "found id = " ++ show id'+ hPutStr handle $ "t\n" ++ "compile " ++ show id' ++ "\n"+ hFlush handle+ readRes handle+ hPutStrLn handle "n"+ hFlush handle+ hClose handle+ _ -> putStrLn $ usageInfo header options+ _ -> putStrLn $ usageInfo header options++findId :: Handle -> String -> IO (Maybe Int)+findId handle tgt = do+ hPutStr handle "t\ninfo\n"+ hFlush handle+ res <- readRes' handle+ print res+ return $ fnd res+ where+ fnd :: [String] -> Maybe Int+ fnd [] = Nothing+ fnd [_] = Nothing+ fnd (x1:x2:xs) =+ if trim tgt' == trim tgt+ then Just id+ else fnd xs+ where+ id :: Int+ id = read $ drop 4 x1+ tgt' = drop 7 x2++trim :: String -> String+trim = f . f+ where f = reverse . dropWhile isSpace++readRes :: Handle -> IO ()+readRes handle = lp+ where+ lp = do+ l <- hGetLine handle+ if l == "<FCSH END>"+ then return ()+ else putStrLn l >> hFlush stdout >> lp++readRes' :: Handle -> IO [String]+readRes' handle = lp []+ where+ lp :: [String] -> IO [String]+ lp ls = do+ l <- hGetLine handle+ if l == "<FCSH END>"+ then return (reverse ls)+ else lp (l:ls)++connectOrSpawn :: String -> PortNumber -> IO Handle+connectOrSpawn cmd port = do+ h <- connect port+ if isNothing h+ then spawn cmd >> connect port >>= return . fromJust+ else return $ fromJust h++connect :: PortNumber -> IO (Maybe Handle)+connect port = catch (fmap Just (connectTo "localhost" (PortNumber port))) (\e -> print (e :: SomeException) >> return Nothing)++spawn :: String -> IO ()+spawn cmd = runCommand cmd >> yield >> threadDelay 2000000+