Browse Source

Initial hsfile builder

master
Michael Snoyman 9 years ago
parent
commit
96600122b0
  1. 5
      .gitignore
  2. 85
      MultiFile.hs
  3. 34
      build.hs
  4. 14
      setup.sh

5
.gitignore

@ -0,0 +1,5 @@
*.swp
*.hi
*.o
hsfiles/
yesod-scaffold/

85
MultiFile.hs

@ -0,0 +1,85 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module MultiFile where
import ClassyPrelude.Conduit
import Data.Functor.Identity (runIdentity)
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString as S
import Control.Monad (unless)
import Data.Conduit.List (sinkNull)
import qualified Data.Conduit.Text as CT
import Filesystem.Path.CurrentOS (encode, directory, fromText)
import Filesystem (createTree)
import Control.Monad.Trans.Resource (runExceptionT)
import Data.Conduit.Filesystem (sinkFile)
import Data.Text.Encoding (encodeUtf8)
unpackMultiFile
:: MonadResource m
=> FilePath -- ^ output folder
-> (Text -> Text) -- ^ fix each input line, good for variables
-> Sink ByteString m ()
unpackMultiFile root fixLine =
CT.decode CT.utf8 =$ CT.lines =$ map fixLine =$ start
where
start =
await >>= maybe (return ()) go
where
go t =
case getFileName t of
Nothing -> error $ "Invalid input: " ++ show t
Just (fp', isBinary) -> do
let fp = root </> fromText fp'
liftIO $ createTree $ directory fp
let src
| isBinary = binaryLoop
| otherwise = textLoop
src =$ sinkFile fp
start
binaryLoop = do
await >>= maybe (error "binaryLoop needs 1 line") go
where
go = yield . B64.decodeLenient . encodeUtf8
textLoop =
await >>= maybe (return ()) go
where
go t =
case getFileName t of
Just{} -> leftover t
Nothing -> do
yield $ encodeUtf8 t
yield "\n"
textLoop
getFileName t =
case words t of
["{-#", "START_FILE", fn, "#-}"] -> Just (fn, False)
["{-#", "START_FILE", "BASE64", fn, "#-}"] -> Just (fn, True)
_ -> Nothing
createMultiFile
:: MonadIO m
=> FilePath -- ^ folder containing the files
-> Conduit FilePath m ByteString -- ^ FilePath is relative to containing folder
createMultiFile root = do
awaitForever handleFile
where
handleFile fp' = do
bs <- readFile fp
case runIdentity $ runExceptionT $ yield bs $$ CT.decode CT.utf8 =$ sinkNull of
Left{} -> do
yield "{-# START_FILE BASE64 "
yield $ encode fp'
yield " #-}\n"
yield $ B64.encode bs
yield "\n"
Right{} -> do
yield "{-# START_FILE "
yield $ encode fp'
yield " #-}\n"
yield bs
unless ("\n" `S.isSuffixOf` bs) $ yield "\n"
where
fp = root </> fp'

34
build.hs

@ -0,0 +1,34 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Main (main) where
import ClassyPrelude.Conduit
import Shelly (shellyNoDir, rm_rf, run_, run, fromText, cd)
import Control.Monad (forM_, unless)
import Data.Conduit.Filesystem (sinkFile)
import MultiFile (createMultiFile)
branches :: [LText]
branches = ["postgres", "sqlite", "mysql", "mongo", "simple"]
master :: LText
master = "postgres"
main :: IO ()
main = shellyNoDir $ do
rm_rf "yesod-scaffold"
run_ "git" ["clone", ".", "yesod-scaffold"]
cd "yesod-scaffold"
forM_ branches $ \branch -> do
run_ "git" ["checkout", branch]
unless (branch == master) $ run_ "git" ["merge", master]
run_ "git" ["diff", "--exit-code"]
run_ "cabal" ["install", "--only-dependencies"]
run_ "yesod" ["test"]
run_ "git" ["clean", "-fxd"]
files <- run "git" ["ls-tree", "-r", branch, "--name-only"]
liftIO
$ runResourceT
$ mapM_ (yield . fromText) (lines files)
$$ createMultiFile "yesod-scaffold"
=$ sinkFile ("hsfiles" </> fromText branch <.> "hsfiles")

14
setup.sh

@ -0,0 +1,14 @@
#!/bin/bash -x
sudo apt-get install postgresql mysql-server -y
sudo -u postgres psql <<EOF
CREATE USER "PROJECTNAME" password 'PROJECTNAME';
CREATE DATABASE "PROJECTNAME_test" OWNER "PROJECTNAME";
EOF
sudo mysql -u root -p <<EOF
CREATE DATABASE PROJECTNAME_test;
GRANT USAGE ON *.* TO PROJECTNAME@localhost IDENTIFIED BY 'PROJECTNAME';
GRANT ALL PRIVILEGES ON PROJECTNAME_test.* TO PROJECTNAME@localhost;
EOF
Loading…
Cancel
Save