@@ -1,19 +1,60 @@
11{-# LANGUAGE DeriveDataTypeable #-}
2+{-# LANGUAGE OverloadedStrings #-}
23import Network.Wai.Handler.DevelServer (runQuit)
34import System.Console.CmdArgs
5+import qualified Data.Attoparsec.Text.Lazy as A
6+import qualified Data.Text.Lazy.IO as TIO
7+import Control.Applicative ((<|>))
8+import Data.Char (isSpace)
9+import Data.Maybe (mapMaybe)
410
511data Devel = Devel
612 { port :: Int
713 , moduleName :: String
814 , function :: String
15+ , yesod :: Bool
916 }
1017 deriving (Show, Data, Typeable)
1118
1219main :: IO ()
1320main = do
14− Devel p m f <- cmdArgs Devel
21+ Devel p m f y <- cmdArgs Devel
1522 { port = 3000 &= argPos 0 &= typ "PORT"
1623 , moduleName = "" &= argPos 1 &= typ "MODULE"
1724 , function = "" &= argPos 2 &= typ "FUNCTION"
25+ , yesod = False
1826 } &= summary "WAI development web server"
19− runQuit p m f $ const $ return []
27+ runQuit p m f $ if y then determineHamletDeps else (const $ return [])
28+
29+data TempType = Hamlet | Cassius | Lucius | Julius | Widget
30+ deriving Show
31+
32+determineHamletDeps :: FilePath -> IO [FilePath]
33+determineHamletDeps x = do
34+ y <- TIO.readFile x
35+ let z = A.parse (A.many $ (parser <|> (A.anyChar >> return Nothing))) y
36+ case z of
37+ A.Fail{} -> return []
38+ A.Done _ r -> return $ mapMaybe go r
39+ where
40+ go (Just (Hamlet, f)) = Just $ "hamlet/" ++ f ++ ".hamlet"
41+ go (Just (Widget, f)) = Just $ "hamlet/" ++ f ++ ".hamlet"
42+ go _ = Nothing
43+ parser = do
44+ ty <- (A.string "$(hamletFile " >> return Hamlet)
45+ <|> (A.string "$(cassiusFile " >> return Cassius)
46+ <|> (A.string "$(luciusFile " >> return Lucius)
47+ <|> (A.string "$(juliusFile " >> return Julius)
48+ <|> (A.string "$(widgetFile " >> return Widget)
49+ <|> (A.string "$(Settings.hamletFile " >> return Hamlet)
50+ <|> (A.string "$(Settings.cassiusFile " >> return Cassius)
51+ <|> (A.string "$(Settings.luciusFile " >> return Lucius)
52+ <|> (A.string "$(Settings.juliusFile " >> return Julius)
53+ <|> (A.string "$(Settings.widgetFile " >> return Widget)
54+ A.skipWhile isSpace
55+ _ <- A.char '"'
56+ y <- A.many1 $ A.satisfy (/= '"')
57+ _ <- A.char '"'
58+ A.skipWhile isSpace
59+ _ <- A.char ')'
60+ return $ Just (ty, y)