mole 0.0.1 → 0.0.2
raw patch · 2 files changed
+81/−29 lines, 2 filesdep +css-syntax
Dependencies added: css-syntax
Files
- mole.cabal +2/−1
- src/Main.hs +79/−28
mole.cabal view
@@ -1,5 +1,5 @@ name: mole-version: 0.0.1+version: 0.0.2 synopsis: A glorified string replacement tool description:@@ -58,6 +58,7 @@ , mtl , kraken , unix+ , css-syntax test-suite spec
src/Main.hs view
@@ -31,6 +31,7 @@ import Data.Mole.Watcher import Data.Mole.Builder import Data.Mole.Builder.External+import Data.Mole.Builder.Binary import Options.Applicative import Options.Applicative.Types@@ -49,14 +50,14 @@ , optPaths :: [FilePath] -- ^ The paths where auto-discovery looks for assets. - , optAssets :: [(AssetId,AssetDefinition)]+ , optAssets :: [(AssetId, Options -> String -> IO AssetDefinition)] -- ^ Additional assets that are specified on the commandline. } data Command = Version | Build !FilePath- | Serve+ | Serve !Int run :: Options -> Command -> IO ()@@ -66,6 +67,7 @@ config <- mkConfig opt outputDir h <- newHandle config + forM_ (entryPoints config) $ \aId -> markDirty h aId @@ -78,7 +80,7 @@ e <- isEmptyTQueue (emitStream h) unless e retry -run opt Serve = do+run opt (Serve port) = do config <- mkConfig opt "" h <- newHandle config @@ -89,7 +91,7 @@ forM_ (entryPoints config) $ \aId -> markDirty h aId - serveFiles h+ serveFiles h port collectAssetDefinitions :: FilePath -> FilePath -> IO (Map AssetId AssetDefinition)@@ -110,8 +112,25 @@ transformPublicIdentifierDef pubId = '/' : pubId +locateSource :: Options -> AssetId -> IO (Maybe (String, String))+locateSource opt (AssetId aId) = 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):_ -> return $ Just (basePath, x)+ _ -> return Nothing++ where+ f = do+ p <- filePath+ t <- fileType+ return $ t == RegularFile && isSuffixOf aId p++ defAutoDiscovery :: Options -> FilePath -> Handle -> AssetId -> IO (Maybe AssetDefinition)-defAutoDiscovery opt outputDir h (AssetId aId)+defAutoDiscovery opt outputDir _ (AssetId aId) | aId == "" = do return $ Just $ AssetDefinition (externalBuilder aId) id (emitResultDef outputDir) | isURI aId = do@@ -120,24 +139,15 @@ -- 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+ mbSource <- locateSource opt (AssetId aId)+ case mbSource of+ Nothing -> return Nothing+ Just (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@@ -147,21 +157,36 @@ 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+ oAssets <- forM (optAssets opt) $ \(aId, m) -> do+ ad <- m opt outputDir+ return (aId, ad)++ let allAssets = M.fromList oAssets <> 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+ -- let otherAssets = M.fromList $ (flip map) (optEntryPoints opt) $ \(AssetId aId) ->+ -- ( AssetId aId+ -- , AssetDefinition (rawBuilder aId "application/octet-stream" ("_site/" ++ aId)) transformPublicIdentifierDef (emitResultDef outputDir)+ -- ) + return $ Config (allAssets <> otherAssets) (defAutoDiscovery opt outputDir)+ (allEntryPoints ++ (map fst $ optAssets opt)) + parseOptions :: Parser Options-parseOptions = Options <$> parseCommand <*> parsePaths <*> many parseAsset+parseOptions = (\cmd paths extAssets rawAssets -> Options cmd paths (extAssets <> rawAssets))+ <$> parseCommand+ <*> parsePaths+ <*> many (parseAsset Ext)+ <*> many (parseAsset Raw) parseCommand :: Parser Command parseCommand = subparser $ mconcat@@ -181,18 +206,44 @@ <$> strArgument (metavar "OUTPUT-DIRECTORY" <> help "Where to write the files to.") parseServe :: Parser Command-parseServe = pure Serve+parseServe = Serve+ <$> option auto (long "port" <> short 'p' <> metavar "PORT" <> value 8000) -assetRead :: ReadM (AssetId, AssetDefinition)-assetRead = ReadM $ do+assetIdRead :: ReadM AssetId+assetIdRead = ReadM $ do v <- ask+ return $ AssetId v++data AssetType = Ext | Raw++assetRead :: AssetType -> ReadM (AssetId, Options -> String -> IO AssetDefinition)+assetRead at = ReadM $ do+ v <- ask case map T.unpack $ T.splitOn "=" $ T.pack v of- [aId, p] -> return $ (AssetId aId, AssetDefinition (externalBuilder p) id (\_ _ _ -> return ()))+ [aId, p] -> return $ ad aId p _ -> fail "ASSET=DEFINITION" -parseAsset :: Parser (AssetId, AssetDefinition)-parseAsset = option assetRead- ( long "asset" <> short 'a' <> metavar "ASSET=DEFINITION" )+ where+ ad aId p = case at of+ Ext -> (AssetId aId, \_ _ -> return $ AssetDefinition (externalBuilder p) id (\_ _ _ -> return ()))+ Raw ->+ ( AssetId aId+ , \opt outputDir -> do+ mbSource <- locateSource opt (AssetId aId)+ case mbSource of+ Nothing -> error $ "Could not find asset " ++ aId+ Just (_, p') -> do+ return $ AssetDefinition (rawBuilder p p' "application/octet-stream") transformPublicIdentifierDef (emitResultDef outputDir)+ )+++parseAsset :: AssetType -> Parser (AssetId, Options -> String -> IO AssetDefinition)+parseAsset at = option (assetRead at)+ ( long (prefix <> "-asset") <> metavar "ASSET=DEFINITION" )+ where+ prefix = case at of+ Ext -> "external"+ Raw -> "raw" parsePaths :: Parser [FilePath]