haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Cleaned up Scaffold.Build

Browse Source
This commit is contained in:
Michael Snoyman 2011-07-17 21:06:49 +03:00
parent c9eaf84694
commit 9adf931c67
1 changed files with 10 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
Scaffold/Build.hs
View File

@ -8,22 +8,16 @@ module Scaffold.Build
-- FIXME there's a bug when getFileStatus applies to a file temporary deleted (e.g., Vim saving a file) -- FIXME there's a bug when getFileStatus applies to a file temporary deleted (e.g., Vim saving a file)
import qualified Distribution.Simple.Build as B
import System.Directory (getDirectoryContents, doesDirectoryExist, doesFileExist) import System.Directory (getDirectoryContents, doesDirectoryExist, doesFileExist)
import Data.List (isSuffixOf) import Data.List (isSuffixOf)
import Distribution.Simple.Setup (defaultBuildFlags)
import Distribution.Simple.Configure (getPersistBuildConfig)
import Distribution.Simple.LocalBuildInfo
import qualified Data.Attoparsec.Text.Lazy as A import qualified Data.Attoparsec.Text.Lazy as A
import qualified Data.Text.Lazy.IO as TIO import qualified Data.Text.Lazy.IO as TIO
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.Maybe (mapMaybe)
import Data.Monoid (mappend) import Data.Monoid (mappend)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import System.PosixCompat.Files (accessTime, modificationTime, getFileStatus, setFileTimes, FileStatus) import System.PosixCompat.Files (accessTime, modificationTime, getFileStatus, setFileTimes)
import Data.Text (unpack)
import Control.Monad (filterM, forM) import Control.Monad (filterM, forM)
import Control.Exception (SomeException, try) import Control.Exception (SomeException, try)
@ -35,25 +29,6 @@ touch = do
let deps = fixDeps $ zip hss deps' let deps = fixDeps $ zip hss deps'
touchDeps deps touchDeps deps
build :: IO ()
build = do
{-
cabal <- defaultPackageDesc normal
gpd <- readPackageDescription normal cabal
putStrLn $ showPackageDescription $ packageDescription gpd
-}
hss <- findHaskellFiles "."
deps' <- mapM determineHamletDeps hss
let deps = fixDeps $ zip hss deps'
touchDeps deps
lbi <- getPersistBuildConfig "dist"
B.build
(localPkgDescr lbi)
lbi
defaultBuildFlags
[]
type Deps = Map.Map FilePath (Set.Set FilePath) type Deps = Map.Map FilePath (Set.Set FilePath)
getDeps :: IO Deps getDeps :: IO Deps
@ -136,18 +111,18 @@ determineHamletDeps x = do
<|> (A.string "$(persistFile " >> return Verbatim) <|> (A.string "$(persistFile " >> return Verbatim)
<|> (A.string "$(parseRoutesFile " >> return Verbatim) <|> (A.string "$(parseRoutesFile " >> return Verbatim)
<|> (do <|> (do
A.string "\nmkMessage \"" _ <- A.string "\nmkMessage \""
A.skipWhile (/= '"') A.skipWhile (/= '"')
A.string "\" \"" _ <- A.string "\" \""
x <- A.many1 $ A.satisfy (/= '"') x' <- A.many1 $ A.satisfy (/= '"')
A.string "\" \"" _ <- A.string "\" \""
y <- A.many1 $ A.satisfy (/= '"') y <- A.many1 $ A.satisfy (/= '"')
A.string "\"" _ <- A.string "\""
return $ Messages $ concat [x, "/", y, ".msg"]) return $ Messages $ concat [x', "/", y, ".msg"])
<|> (do <|> (do
A.string "\nstaticFiles \"" _ <- A.string "\nstaticFiles \""
x <- A.many1 $ A.satisfy (/= '"') x' <- A.many1 $ A.satisfy (/= '"')
return $ StaticFiles x) return $ StaticFiles x')
case ty of case ty of
Messages{} -> return $ Just (ty, "") Messages{} -> return $ Just (ty, "")
StaticFiles{} -> return $ Just (ty, "") StaticFiles{} -> return $ Just (ty, "")