\begin{code} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE CPP #-} module Main (main) where import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Char import Data.IORef import qualified Data.List as L import qualified Data.Map as Map import Data.Maybe import Data.Monoid import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Prelude.Compat import qualified Shelly as SH import System.Directory import System.Environment import System.Exit import System.IO import TestKit import Text.Printf import Text.RE.TDFA.ByteString.Lazy main :: IO () main = do (pn,as) <- (,) <$> getProgName <*> getArgs case as of [] -> test ["test"] -> test ["sdist"] -> sdist ["gen"] -> do gen "lib/cabal-masters/mega-regex.cabal" "lib/mega-regex.cabal" gen "lib/cabal-masters/regex.cabal" "lib/regex.cabal" gen "lib/cabal-masters/regex-examples.cabal" "lib/regex-examples.cabal" establish "mega-regex" "regex" _ -> do hPutStrLn stderr $ "usage: " ++ pn ++ " [test|sdist|gen]" exitWith $ ExitFailure 1 test :: IO () test = do createDirectoryIfMissing False "tmp" gen "lib/cabal-masters/mega-regex.cabal" "tmp/mega-regex.cabal" ok <- cmp "tmp/mega-regex.cabal" "lib/mega-regex.cabal" case ok of True -> return () False -> exitWith $ ExitFailure 1 gen :: FilePath -> FilePath -> IO () gen in_f out_f = do ctx <- setup LBS.writeFile out_f =<< sed' (gc_script ctx) =<< substVersion_ =<< include =<< LBS.readFile in_f data Ctx = Ctx { _ctx_package_constraints :: IORef (Map.Map LBS.ByteString LBS.ByteString) , _ctx_test_exe :: IORef (Maybe TestExe) } data TestExe = TestExe { _te_test :: Bool , _te_exe :: Bool , _te_name :: LBS.ByteString , _te_text :: LBS.ByteString } deriving (Show) setup :: IO Ctx setup = Ctx <$> (newIORef Map.empty) <*> (newIORef Nothing) gc_script :: Ctx -> SedScript RE gc_script ctx = Select [ (,) [re|^%- +${pkg}(@{%id-}) +${cond}(.*)$|] $ EDIT_gen $ cond_gen ctx , (,) [re|^%build-depends +${list}(@{%id-}( +@{%id-})+)$|] $ EDIT_gen $ build_depends_gen ctx , (,) [re|^%test +${i}(@{%id-})$|] $ EDIT_gen $ test_exe_gen True False ctx , (,) [re|^%exe +${i}(@{%id-})$|] $ EDIT_gen $ test_exe_gen False True ctx , (,) [re|^%test-exe +${i}(@{%id-})$|] $ EDIT_gen $ test_exe_gen True True ctx , (,) [re|^.*$|] $ EDIT_gen $ default_gen ctx ] cond_gen, build_depends_gen, default_gen :: Ctx -> LineNo -> Matches LBS.ByteString -> IO (LineEdit LBS.ByteString) cond_gen Ctx{..} _ mtchs = do modifyIORef _ctx_package_constraints $ Map.insert pkg cond return Delete where pkg = captureText [cp|pkg|] mtch cond = captureText [cp|cond|] mtch mtch = allMatches mtchs !! 0 build_depends_gen ctx@Ctx{..} _ mtchs = do mp <- readIORef _ctx_package_constraints put ctx $ mk_build_depends mp lst where lst = LBS.words $ captureText [cp|list|] mtch mtch = allMatches mtchs !! 0 default_gen ctx@Ctx{..} _ mtchs = do mb <- readIORef _ctx_test_exe case mb of Nothing -> return $ ReplaceWith ln Just te -> case isSpace $ LBS.head $ ln<>"\n" of True -> put ctx ln False -> adjust_le (<>ln) <$> close_test_exe ctx te where ln = matchSource mtch mtch = allMatches mtchs !! 0 test_exe_gen :: Bool -> Bool -> Ctx -> LineNo -> Matches LBS.ByteString -> IO (LineEdit LBS.ByteString) test_exe_gen is_t is_e ctx _ mtchs = do mb <- readIORef (_ctx_test_exe ctx) le <- maybe (return Delete) (close_test_exe ctx) mb writeIORef (_ctx_test_exe ctx) $ Just $ TestExe { _te_test = is_t , _te_exe = is_e , _te_name = i , _te_text = "" } return le where i = captureText [cp|i|] mtch mtch = allMatches mtchs !! 0 close_test_exe :: Ctx -> TestExe -> IO (LineEdit LBS.ByteString) close_test_exe ctx@Ctx{..} te = do writeIORef _ctx_test_exe Nothing put ctx $ mconcat $ concat $ [ [ mk_test_exe False te "Executable" | _te_exe te ] , [ mk_test_exe True te "Test-Suite" | _te_test te ] ] put :: Ctx -> LBS.ByteString -> IO (LineEdit LBS.ByteString) put Ctx{..} lbs = do mb <- readIORef _ctx_test_exe case mb of Nothing -> return $ ReplaceWith lbs Just te -> do writeIORef _ctx_test_exe $ Just te { _te_text = _te_text te <> lbs <> "\n" } return Delete mk_test_exe :: Bool -> TestExe -> LBS.ByteString -> LBS.ByteString mk_test_exe is_t te te_lbs_kw = (<>_te_text te) $ LBS.unlines $ concat [ [ LBS.pack $ printf "%s %s" (LBS.unpack te_lbs_kw) nm ] , [ " type: exitcode-stdio-1.0" | is_t ] ] where nm = case is_t of True -> LBS.unpack $ _te_name te <> "-test" False -> LBS.unpack $ _te_name te mk_build_depends :: Map.Map LBS.ByteString LBS.ByteString -> [LBS.ByteString] -> LBS.ByteString mk_build_depends mp pks = LBS.unlines $ (:) " Build-depends:" $ map fmt $ zip (True : repeat False) $ L.sortBy comp pks where fmt (isf,pk) = LBS.pack $ printf " %c %-20s %s" (if isf then ' ' else ',') (LBS.unpack pk) (maybe "" LBS.unpack $ Map.lookup pk mp) comp x y = case (x=="regex",y=="regex") of (True ,True ) -> EQ (True ,False) -> LT (False,True ) -> GT (False,False) -> compare x y adjust_le :: (LBS.ByteString->LBS.ByteString) -> LineEdit LBS.ByteString -> LineEdit LBS.ByteString adjust_le f le = case le of NoEdit -> error "adjust_le: not enough context" ReplaceWith lbs -> ReplaceWith $ f lbs Delete -> ReplaceWith $ f "" \end{code} \begin{code} sdist :: IO () sdist = do sdist' "regex" sdist' "regex-examples" establish "mega-regex" "regex" vrn_t <- T.pack . presentVrn <$> readCurrentVersion smy_t <- summary SH.shelly $ SH.verbosely $ SH.run_ "git" ["tag",vrn_t,"-m",smy_t] sdist' :: T.Text -> IO () sdist' nm = do establish nm nm SH.shelly $ SH.verbosely $ do SH.cp readme "README.markdown" SH.run_ "cabal" ["clean"] SH.run_ "cabal" ["configure"] SH.run_ "cabal" ["sdist"] vrn <- SH.liftIO readCurrentVersion let tb = nm<>"-"<>T.pack(presentVrn vrn)<>".tar.gz" SH.cp (SH.fromText $ "dist/"<>tb) $ SH.fromText $ "releases/"<>tb where readme = SH.fromText $ "lib/README-"<>nm<>".md" establish :: T.Text -> T.Text -> IO () establish nm nm' = SH.shelly $ SH.verbosely $ do SH.rm_f "mega-regex.cabal" SH.rm_f "regex.cabal" SH.rm_f "regex-examples.cabal" SH.cp (SH.fromText sf) (SH.fromText df) where sf = "lib/"<>nm<>".cabal" df = nm'<>".cabal" summary :: IO T.Text summary = do vrn <- SH.liftIO readCurrentVersion let vrn_res = concat [ show $ _vrn_a vrn , "\\." , show $ _vrn_b vrn , "\\." , show $ _vrn_c vrn , "\\." , show $ _vrn_d vrn ] rex <- compileRegex () $ "- \\[[xX]\\] +@{%date} +v"++vrn_res++" +\\[?${smy}([^]]+)" lns <- linesMatched <$> grepLines rex "lib/md/roadmap-incl.md" case lns of [Line _ (Matches _ [mtch])] -> return $ TE.decodeUtf8 $ LBS.toStrict $ mtch !$$ [cp|smy|] _ -> error "failed to locate the summary text in the roadmap" \end{code} let vrn_res = concat [ show $ _vrn_a vrn, "\\.", show $ _vrn_b vrn, "\\.", show $ _vrn_c vrn, "\\.", show $ _vrn_d vrn ]