mole (empty) → 0.0.1
raw patch · 5 files changed
+371/−0 lines, 5 filesdep +attoparsecdep +basedep +base64-bytestringsetup-changed
Dependencies added: attoparsec, base, base64-bytestring, bytestring, containers, cryptohash, directory, filemanip, filepath, fsnotify, hspec, hspec-smallcheck, kraken, mtl, network-uri, optparse-applicative, process, smallcheck, snap, snap-server, stm, system-filepath, tagsoup, text, time, transformers, unix, unordered-containers, vector
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- mole.cabal +83/−0
- src/Main.hs +210/−0
- test/Test.hs +56/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Tomas Carnecky++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ mole.cabal view
@@ -0,0 +1,83 @@+name: mole+version: 0.0.1++synopsis: A glorified string replacement tool+description:+ A glorified string replacement tool. For a very specific purpose. That+ purpose being to compile and optimize a static website (or a single-page+ application). Mole inspects source, builds a complete dependency tree,+ minifies and compresses the files, adds fingerprints and writes the result+ to a directory.++license: MIT+license-file: LICENSE+author: Tomas Carnecky+maintainer: tomas.carnecky@gmail.com++category: System++build-type: Simple+cabal-version: >=1.10+++source-repository head+ type: git+ location: git://github.com/wereHamster/mole.git+++executable mole+ hs-source-dirs: src+ default-language: Haskell2010++ ghc-options: -Wall -threaded -O2 -rtsopts++ main-is: Main.hs++ build-depends:+ base >=4.6 && <4.9+ , containers+ , bytestring+ , base64-bytestring+ , tagsoup+ , stm+ , cryptohash+ , filepath+ , filemanip+ , fsnotify+ , directory+ , system-filepath+ , snap+ , snap-server+ , text+ , transformers+ , process+ , attoparsec+ , network-uri+ , optparse-applicative+ , time+ , mtl+ , kraken+ , unix+++test-suite spec+ hs-source-dirs: src test+ default-language: Haskell2010++ main-is: Test.hs+ type: exitcode-stdio-1.0++ build-depends:+ base <4.9+ , hspec+ , smallcheck+ , hspec-smallcheck+ , vector+ , text+ , unordered-containers+ , time+ , kraken+ , attoparsec+ , stm+ , bytestring+ , containers
+ src/Main.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Concurrent.STM+import Control.Monad+import Control.Monad.Reader+import Control.Applicative++import Data.Map (Map)+import qualified Data.Map as M++import qualified Data.Set as S++import qualified Data.ByteString as BS++import qualified Data.Text as T++import Data.Monoid+import Data.List hiding (stripPrefix)++import Network.URI++import System.FilePath+import System.FilePath.Find as FPF+import System.Directory++import Data.Mole.Types+import Data.Mole.Core+import Data.Mole.Server+import Data.Mole.Watcher+import Data.Mole.Builder+import Data.Mole.Builder.External++import Options.Applicative+import Options.Applicative.Types++++main :: IO ()+main = do+ opt <- execParser (parseOptions `withInfo` "mole")+ run opt (optCommand opt)+++data Options = Options+ { optCommand :: Command++ , optPaths :: [FilePath]+ -- ^ The paths where auto-discovery looks for assets.++ , optAssets :: [(AssetId,AssetDefinition)]+ -- ^ Additional assets that are specified on the commandline.+ }++data Command+ = Version+ | Build !FilePath+ | Serve+++run :: Options -> Command -> IO ()+run _ Version = putStrLn "HEAD"++run opt (Build outputDir) = do+ config <- mkConfig opt outputDir+ h <- newHandle config++ forM_ (entryPoints config) $ \aId ->+ markDirty h aId++ _ <- require h (S.fromList $ entryPoints config)+ atomically $ do+ e <- isEmptyTQueue (messages h)+ unless e retry++ atomically $ do+ e <- isEmptyTQueue (emitStream h)+ unless e retry++run opt Serve = do+ config <- mkConfig opt ""+ h <- newHandle config++ attachFileWatcher h++ -- Mark all entry points as dirty to have the assets ready as soon as+ -- possible, hopefully even before the user opens the web server.+ forM_ (entryPoints config) $ \aId ->+ markDirty h aId++ serveFiles h+++collectAssetDefinitions :: FilePath -> FilePath -> IO (Map AssetId AssetDefinition)+collectAssetDefinitions outputDir basePath = do+ FPF.fold (pure True) f M.empty basePath+ where+ f m fi = if takeExtension p == ".html"+ then M.insert+ (AssetId $ drop (length basePath + 1) $ p)+ (AssetDefinition (builderForFile basePath p) transformPublicIdentifierDef (emitResultDef outputDir))+ m+ else m+ where p = infoPath fi+++transformPublicIdentifierDef :: PublicIdentifier -> PublicIdentifier+transformPublicIdentifierDef ('/':pubId) = '/' : pubId+transformPublicIdentifierDef pubId = '/' : pubId+++defAutoDiscovery :: Options -> FilePath -> Handle -> AssetId -> IO (Maybe AssetDefinition)+defAutoDiscovery opt outputDir h (AssetId aId)+ | aId == "" = do+ return $ Just $ AssetDefinition (externalBuilder aId) id (emitResultDef outputDir)+ | isURI aId = do+ return $ Just $ AssetDefinition (externalBuilder aId) id (emitResultDef outputDir)+ -- | head aId == '/' = do+ -- logMessage h (AssetId aId) $ "Starts with a slash, treating as external!"+ -- return $ Just $ AssetDefinition (externalBuilder aId) id (emitResultDef outputDir)+ | otherwise = do+ res <- concat <$> mapM (\basePath -> do+ paths <- FPF.find (pure True) f basePath+ return $ zip (repeat basePath) paths+ ) (optPaths opt)+ case sortOn (length . snd) res of+ (basePath, x):_ -> do+ -- logMessage h (AssetId aId) $ "Found asset at " ++ x+ return $ Just $ AssetDefinition (builderForFile basePath x)+ transformPublicIdentifierDef (emitResultDef outputDir)+ _ -> return Nothing+++ where+ f = do+ p <- filePath+ t <- fileType+ return $ t == RegularFile && isSuffixOf aId p++emitResultDef :: FilePath -> Handle -> AssetId -> Result -> IO ()+emitResultDef dist _ _ (Result pubId mbRes) = do+ case mbRes of+ Nothing -> return ()+ Just (body, _) -> when (dist /= "") $ do+ -- putStrLn $ "emit " ++ pubId+ createDirectoryIfMissing True $ dist `joinDrive` (takeDirectory pubId)+ BS.writeFile (dist `joinDrive` pubId) body++mkConfig :: Options -> FilePath -> IO Config+mkConfig opt outputDir = do+ otherAssets <- mconcat <$> mapM (collectAssetDefinitions outputDir) (optPaths opt)++ let allAssets = M.fromList (optAssets opt) <> otherAssets+ let allEntryPoints = filter (\(AssetId a) -> T.isSuffixOf ".html" (T.pack a)) $ M.keys allAssets+ -- print $ M.keys allAssets++ return $ Config allAssets (defAutoDiscovery opt outputDir) allEntryPoints+++++parseOptions :: Parser Options+parseOptions = Options <$> parseCommand <*> parsePaths <*> many parseAsset++parseCommand :: Parser Command+parseCommand = subparser $ mconcat+ [ command "version"+ (parseVersion `withInfo` "Print the version and exit")+ , command "build"+ (parseBuild `withInfo` "Build the website")+ , command "serve"+ (parseServe `withInfo` "Serve the website")+ ]++parseVersion :: Parser Command+parseVersion = pure Version++parseBuild :: Parser Command+parseBuild = Build+ <$> strArgument (metavar "OUTPUT-DIRECTORY" <> help "Where to write the files to.")++parseServe :: Parser Command+parseServe = pure Serve++assetRead :: ReadM (AssetId, AssetDefinition)+assetRead = ReadM $ do+ v <- ask+ case map T.unpack $ T.splitOn "=" $ T.pack v of+ [aId, p] -> return $ (AssetId aId, AssetDefinition (externalBuilder p) id (\_ _ _ -> return ()))+ _ -> fail "ASSET=DEFINITION"++parseAsset :: Parser (AssetId, AssetDefinition)+parseAsset = option assetRead+ ( long "asset" <> short 'a' <> metavar "ASSET=DEFINITION" )+++parsePaths :: Parser [FilePath]+parsePaths = option pathRead+ ( long "paths" <> short 'p' <> metavar "SEARCH:PATH:DIRS:..."<> value ["assets/"] )+ where+ pathRead = ReadM $ do+ v <- ask+ case map T.unpack $ T.splitOn ":" $ T.pack v of+ (x:xs) -> return $ x:xs+ _ -> fail "SEARCH:PATH:DIRS:..."+++withInfo :: Parser a -> String -> ParserInfo a+withInfo opts desc = info (helper <*> opts) $ progDesc desc
+ test/Test.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where+++import Control.Applicative++import Test.Hspec+import Test.SmallCheck+import Test.SmallCheck.Series+import Test.Hspec.SmallCheck++import Data.Monoid ((<>))+import Data.Function+import Data.List+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as HMS+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time+import Data.Time.Clock.POSIX+++import Data.Mole.Builder.Internal.Template++++main :: IO ()+main = do+ hspec $ spec+++spec :: Spec+spec = do+ describe "Data.Mole.Builder.Internal.Template" $ do+ it "should parse a non-empty string into a single literal" $ do+ property $ \x -> length x > 0 ==>+ template x == Template [Lit $ T.pack x]+ it "should strip whitespace around a var" $ do+ template "<* \nvar \t *>" `shouldBe`+ Template [ Var "var" ]+ it "should parse a string with a var in it" $ do+ template "some <* var *> template" `shouldBe`+ Template [ Lit "some ", Var "var", Lit " template" ]+ it "should parse two directly adjacent vars" $ do+ template "<* v1 *><* v2 *>" `shouldBe`+ Template [ Var "v1", Var "v2" ]+ it "should parse two adjacent vars with a whitespace in between" $ do+ template "<* v1 *> <* v2 *>" `shouldBe`+ Template [ Var "v1", Lit " ", Var "v2" ]+ it "should ignore a false start of a var" $ do+ template "<div><a href='<* var *>'>link</a></div>" `shouldBe`+ Template [ Lit "<div><a href='", Var "var", Lit "'>link</a></div>" ]+ it "should allow literals between two false starts" $ do+ template "<div> <hr> <* var *> <br>" `shouldBe`+ Template [ Lit "<div> <hr> ", Var "var", Lit " <br>" ]