{- SearchPath.hs v. 0.93 Contact: alex@HAppS.org Copyright (c) 2009, HAppS LLC All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of HAppS LLC nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. See usage at http://searchpath.org/usage.txt -} -- module SearchPath where {-- Major Changes: * handling darcs/svn/subversion repos * handling stuff that is inside tgz files at urls * additions to the module map for new stuff that is present in the universe * much cleaner/more-readable/maintainable code -- almost ready to support other lanuages? * substanitially faster * nicer command line options * better usage documentation * handle lonlocal haskell files * run args option to automatically recompile and rerun on source file changes * filter .sp-cache should be filter .dirs in general * negative caching -- look for url file in the directory. if present and young enough skip * supports command sequences to build the pulled repo * add build cmd to tgz * make .sp-cache default to user's homedir * provide module map to executable so it knows where to get any files it came with * FIXED BUG: won't run intpereter is executable exists * make searchpath autorecompile on source changes if compile failed too * write defaulth.map into current directory and use searchpath.default.map if present * FIXED if executable exists and no run? * now all users of cachedir share the same view formally. mapfiles are irrelevant * maintain invariant that changes only via changes to default.map or source hierarchies Bugs: * added -i is too long for stuff that isn't used e.g. just "import Data.Binary" Maybe future features Windows * eliminate dependency on curl for windows users? Reliability * modify default.map to default to using tgz or darcs repos * now that we have invariant should we make hierarchy downloads more frequent? * searchpath clean? * examine: cabal-install, mkcabal, cabal-update, hackage, cabal-upload, Packaging * build using package-info.xml if present * command to build packages and output package-info files with checksums Security * support checksums in tgz so you only need to trust map provider md5 and md5sum Ease of Use * uses SearchPath.map in current directory if present -- but may have project + user+ org map files! so use currentdir + homedir + env map system + global * guess at command line option that refer to modules as in Foo.Bar w/o the .hs * if the target is remote and no compiler then guess runhaskell or runghc * fix remote files to handle --main-is properly if runghc or -o and --make Rejected Features Because we want the invariant to be that changes appear as new files or repo tags * and handle when searchpath updates but source doesnt * support darcs pull if repo already present via , rather than semicolon? * canonicalize path for local stuff? or use hash of mapfile content? Todo: * convert [Modloc] to [(Maybe ClockTime,ModLoc)] DONE * allow format to skip modnames if the next line is a datetime DONE * make outputted command line not include all the modpaths in the maps --- only the ones actually used DONE * recurse on mbTime on moduleChase DONE * return modlocs used rather than listed DONE * verify that command line returns correct modloc in toI DONE * verify that we now do version tracking properly DONE * add --date y/m/d --time h:m:s as conf options; default to now if not specified * add command line option for --version Mod.Name date time * add sp --doc modname to open browser to module documentation based on cabal file * add sp --record ModName to record changes associated with modname and send to owner if sensible * market --} import System.Cmd (rawSystem) import Data.Char import Text.Regex import System.Time import System.Directory import Data.List import System.Environment import Network.URI (escapeURIString) import System.IO import Control.Monad import System.Exit import System.Process import Data.Maybe import qualified Data.Set as Set import qualified Control.Exception as E import Control.Concurrent sys cmd@(a:xs) = -- print cmd >> do rawSystem a xs main = getArgs >>= main' --debug x = print x -- main' ["ghci", "../happs/fobo/haskell/Main.hs", "-idefault.map"] debug x conf msg f = when (verbose conf > x) $ print msg >> f >> return () main' args' = do if args' `elem` [[], ["-h"],["--help"]] then printUsage else do let args = args' ++ ["-i."] conf <- prepConf defaultConf args conf <- if not (useDefaultMap conf) then return conf else do let fp = ".searchpath.default.map" fe <- doesFileExist fp when (not fe) $ getURI conf defaultURI fp >> return () return conf {mapLocs=mapLocs conf ++ [MapFile fp,MapURI defaultURI]} print conf modLocs <- return . concat =<< mapM (getModLocs conf) (mapLocs conf) debug 1 conf "MODLOCS" $ mapM print modLocs time <- getClockTime conf <- return conf {modLocs = modLocs,vTime=diffClockTimes time (TOD 0 0)} doneUsedmbHSFiles <- (mapM (modChase conf) $ hsFiles conf) --let hsFiles' = map fromJust . filter isJust . map snd let hsFiles' = map fromJust $ filter isJust $ map snd $ doneUsedmbHSFiles used = concat $ map (Set.toList . snd . fst) doneUsedmbHSFiles conf <- return conf {hsFiles=hsFiles' ,usedModLocs=used} print $ confToCmdLine conf doRun conf Nothing return () version = "0.93" printUsage = do putStr $ "SearchPath "++version ++ "\n\n" sys $ words "curl http://searchpath.org/usage.txt" return () {-- try to recompile every second if exe changes then restart this could be cleaned up!!!! --} doRun conf mbPid = compile conf >>= \ret -> if isNothing (runArgs conf) then return () else case ret of (Left True) | isJust mbPid -> threadDelay (10^6) >> doRun conf mbPid (Left False) -> do --putStr "Compiler error. Press to try again.\n" writeFile (temp_targ $ target conf) "abc" waitForFileChange conf putStr "Files changed so trying to compile again...\n" hFlush stdout doRun conf mbPid _ -> do when (isJust mbPid) $ kill (fromJust mbPid) hPutStr stdout "New executable. (Re-) starting\n" doRun conf . Just =<< runProgram targ (fromJust $ runArgs conf) where kill pid = terminateProcess pid >> waitForProcess pid >> return () getEnter c = if c=='\n' then return () else getChar >>= getEnter targ = target conf waitForFileChange conf = do let temp = temp_targ $ target conf mapDirs = (".":getMapDirs conf) news1 <- hasNewer temp mapDirs news2 <- hasNewer temp (hsFiles conf) if news1 || news2 then return () else do threadDelay (10^6) >> waitForFileChange conf compile::Conf -> IO (Either Bool String) -- success or success and new executable compile conf = do let cmdLine = confToCmdLine conf temp = temp_targ $ target conf mapDirs = (".":getMapDirs conf) news1 <- hasNewer (target conf) mapDirs news2 <- hasNewer (target conf) (hsFiles conf) if not news1 && not news2 && (isJust $ runArgs conf) then return $ Left True else do ret <- sys $ words cmdLine fe <- doesFileExist temp if ret/=ExitSuccess then return $ Left False else do when fe $ move temp (target conf) >> return () return $ Right $ target conf {-- source files changed in -i dirs not full recompile --} hasNewer fp dirs = do fe <- doesFileExist fp if not fe then return True else do TOD ft _ <- getModificationTime fp modSince ft dirs modSince t [] = return False modSince t (fp:fps)= do fe <- doesFileExist fp TOD ft 0 <- if fe then getModificationTime fp else return $ TOD 0 0 if isSourceFile fp && ft > t then return True else do de <- doesDirectoryExist fp if (not de) then modSince t fps else do todo <- return . map ((fp++"/")++) . filter (/=".") . filter (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZ_" . head) . filter ((not . flip elem "._") . head) =<< getDirectoryContents fp contSince <- modSince t todo if contSince then return True else modSince t fps isSame a b = do (inh,outh,errh,p) <- runInteractiveCommand $ unwords ["diff","-Nq",a,b] return . null =<< hGetContents outh ls = sys ["ls"] rm fp = sys ["rm",fp] move a b = sys ["mv",a,b] runProgram binary args = do exe <- canonicalizePath binary print (exe:args) runProcess exe args Nothing Nothing Nothing Nothing Nothing data ModLoc = ModDir FilePath | ModURI MapDir ModBase URI -- becomes -i MapId if not already sepecific | ModTGZ MapDir ModBase URI (Maybe BuildCmd) FilePath | ModRepo MapDir ModBase RepoCmd FilePath -- FilePath is relative to location of repocmd deriving (Show,Ord,Eq) modBase (ModURI _ mb _) = mb modBase (ModTGZ _ mb _ _ _) =mb modBase (ModRepo _ mb _ _) = mb modBaseString = concat .intersperse "." . modBase data MapLoc = MapDir FilePath | MapFile FilePath | MapURI URI deriving Show type ModBase = [String] type MapDir= FilePath type RepoCmd = String type BuildCmd = String type URI = String {-- take command line options and turn them into a configuation --} data Conf = Conf {hsFiles::[FilePath] -- if file not found on current path then pulls from net ,modLocs,usedModLocs::[(Maybe TimeDiff,ModLoc)] -- [(Maybe CalendarTime,ModLoc)] ,mapLocs::[MapLoc] ,cargs::[String] ,cacheDir::String ,exe::String ,maxAge::Integer -- how long in seconds since files were retrieved ,glasgow::Bool ,start::Integer ,verbose::Int ,target::String ,useDefaultMap::Bool ,runArgs::Maybe [String] ,vTime::TimeDiff } deriving Show exts = words "-cpp -XTemplateHaskell -XExistentialQuantification -XOverlappingInstances -DUSE_NEW_EXCEPTIONS -XDeriveDataTypeable -XFlexibleInstances -XMultiParamTypeClasses -XStandaloneDeriving -XGeneralizedNewtypeDeriving -XUndecidableInstances -XTypeFamilies " -- exts = "-fglasgow-exts -XExistentialQuantification " temp_targ targ = targ ++ ".sp.new" confToCmdLine conf = concat $ intersperse " " $ (exe conf):toI conf ++ (if null $ target conf then [] else ["-o",temp_targ $ target conf]) ++ (if glasgow conf then exts else []) ++ (hsFiles conf) ++ (cargs conf) toI conf = map impl mods where mods = map head $ groupBy modMatch $ map snd $ usedModLocs conf modMatch (ModURI m1 _ _) (ModURI m2 _ _) = m1==m2 modMatch (ModTGZ m1 _ uri1 c1 b1) (ModTGZ m2 _ uri2 c2 b2) = (m1,uri1,c1,b1)==(m2,uri2,c2,b2) modMatch _ _ = False impl (ModDir fp) = "-i"++fp impl (ModURI mapdir _ _ ) = "-i"++mapdir impl (ModRepo mapdir _ repoCmd baseDir) = "-i"++mapdir++"/"++(escapeURI repoCmd) ++ "/" ++ baseDir impl (ModTGZ mapdir _ uri _ baseDir) = "-i"++mapdir++"/"++(escapeURI uri) ++ "/" ++ baseDir getMapDirs conf = [dir | MapDir dir <- mapLocs conf] defaultConf = Conf {hsFiles=[],mapLocs=[],modLocs=[],usedModLocs = [],cacheDir="", -- .sp-cache", maxAge=3600*24*14,exe="",glasgow=True,cargs=[],start=0 ,verbose=0,runArgs=Nothing,target="",useDefaultMap=True,vTime=noTimeDiff } defaultURI="http://searchpath.org/default.map" prepConf conf [] = do conf <- if null $ cacheDir conf then do appDataDir <- getAppUserDataDirectory "SearchPath" return conf {cacheDir=appDataDir} else return conf conf <- return conf {target = if not $ null (target conf) then target conf else "Main.exe"} createMissingDir (cacheDir conf) now <- getClockTime let TOD secs _ = now dirAge <- getModificationTime (cacheDir conf) >>= (return . tdSec . diffClockTimes now) return conf {hsFiles = reverse $ hsFiles conf ,mapLocs = (reverse $ mapLocs conf) ,cargs = reverse $ cargs conf ,maxAge = max 120 $ maxAge conf ---min dirAge $ maxAge conf ,glasgow = glasgow conf && (exe conf `elem` (words "ghc runghc ghci")) ,start=secs } prepConf conf ("--sp-verbose":d:args) = prepConf conf {verbose=read d} args prepConf conf ("--no-default-map":args) = prepConf conf {useDefaultMap=False} args prepConf conf ("--cache-dir":cd:args) = prepConf conf {cacheDir=cd} args prepConf conf ("--no-exts":args) = prepConf conf {glasgow=False} args prepConf conf (('-':'i':path'):args') = do let (path:args)=if null $ words path' then args' else (path':args') exist <- doesFileExist path isDir <- doesDirectoryExist path if isDir then prepConf conf {mapLocs = MapDir path:mapLocs conf} args else do if exist then prepConf conf {mapLocs = MapFile path:mapLocs conf} args else do prepConf conf {mapLocs = MapURI path:mapLocs conf} args prepConf conf ("--maxAge":t:args) = prepConf conf {maxAge=read t} args prepConf conf ("--max-age":t:args) = prepConf conf {maxAge=read t} args prepConf conf ("--run":args) = prepConf conf {runArgs = Just args} [] prepConf conf ("-o":arg:args) = prepConf conf {target = arg} args prepConf conf (arg:args) | null $ exe conf = prepConf conf {exe=arg} args | not ("run" `isPrefixOf` (exe conf)) --not runhaskell or runhugs or runghc && isSourceFile arg = prepConf conf {hsFiles=arg:hsFiles conf} args | isSourceFile arg && (null $ hsFiles conf) = prepConf conf {hsFiles = arg:hsFiles conf} args | otherwise = prepConf conf {cargs = arg:cargs conf} args sourceExts = words ".hs .lhs .ehs" isSourceFile path = any (`isSuffixOf` path) sourceExts ----------------- getModLocs conf (MapDir fp) = return [(Nothing,ModDir fp)] getModLocs conf (MapFile filePath) = getModLocs' (mapDir conf filePath) filePath getModLocs conf (MapURI uri) = do let fp = mapFile conf uri getURI conf uri fp fe <- doesFileExist fp if fe then getModLocs' (mapDir conf uri) fp else do hPutStr stderr errMsg return [] where errMsg = "\nWarning: Searchpath could not use curl to retrieve uri "++ uri++"\n"++ "Either curl is not configured properly on this machine or the uri is not avilable at the moment.\n\n" getModLocs' mapdir filePath = do file <- readFile' filePath >>= return . unlines . filter (not . null) . map (ltrim . takeWhile (/='#')) . lines -- handle multiple versions of the same module hierarchy let doLines _ [] = [] doLines prior (line:lines) | isNumber $ head line = toML (prior:els):doLines prior lines | length els == 1 = doLines (head els) lines | otherwise = modLocTime:doLines modString lines where toML = toModLocTime mapdir els = words line modLocTime = toML els modString = modBaseString $ snd modLocTime return $ doLines "" $ lines file --return $ map (toModLocTime mapdir . words) $ lines file toModLocTime mapdir els@(modBase:rest) | null dateTimeEls = (Nothing,toModLoc mapdir els) | otherwise = (Just dateTime,toModLoc mapdir $ modBase:rest') where (dateTimeEls,rest') = span (isNumber . head) $ rest (dateStr:timeStr) = dateTimeEls [year,month,day] = map read $ words $ tr '-' ' ' $ dateStr t@[hour,minute,second] = map read $ words $ tr ':' ' ' $ head timeStr date = noTimeDiff { tdYear = year,tdMonth =month,tdDay = day} dateTime = if null timeStr then date else date {tdHour = hour,tdMin=minute,tdSec=second} --(datetimeels,rest)= partition (isNumber . head) line toModLoc::String -> [String] -> ModLoc toModLoc mapdir (modbase':rest) | len == 1 = ModURI mapdir modbase (head rest) | len == 2 = ModTGZ mapdir modbase (head rest) Nothing pos2 | head pos2=='"' = ModTGZ mapdir modbase (head rest) buildCmd (last rest) | otherwise = ModRepo mapdir modbase repoCmd (last rest) where len = length rest pos2 = (head $ tail rest) modbase = words $ tr '.' ' ' $ modbase' buildCmd = Just $ read $ r $ drop 1 rest -- modbase and tgz url r x = unwords $ init $ x repoCmd = case read (unwords $ init rest) of s | head (words s) `elem` vcs -> s | otherwise -> "echo UNKNOWN VC: "++show s vcs = words "darcs ln svn cvs arch svk git bzr mercurial rcs cp curl sp configure make tar" ++ words "bzip2 echo runhaskell runghc runhugs cabal" {-- File format is Module.Base http://base/uri #comment #comment # blanklines allowed Module.Base "darcs or svn or cvs command" rel/path/from/command Mos.Base http://foo/bar.tgz rel/path/from/extract/tgz --} ltrim::String->String ltrim = dropWhile (flip elem " \t\r") mapFile conf path = cacheDir conf ++ '/':escapeURI path mapDir conf path = cacheDir conf -- mapFile conf path ++ ".dir" escapeURI = tr ';' '@' . tr '%' '@' . escapeURIString (not.flip elem "?:/\\'\"%") . tr '/' '-' . tr ' ' '_' . replace "://" "_" . unwords . words tr a b list = map (\x->if x==a then b else x) list replace _ _ [] = [] replace a b list@(h:rest) = if isPrefixOf a list then b ++ drop (length a) list else h:replace a b rest ---------------------------- createMissingDir dir = do de <- doesDirectoryExist dir unless de $ do createDirectoryIfMissing True dir getDir path = reverse $ dropWhile (/='/') $ reverse path defaultModificationTime fp = do fe <- doesFileExist fp if fe then getModificationTime fp else return (TOD 0 0) mbFileExists fp = do --de <- doesDirectoryExist fp fe <- doesFileExist fp if fe then return $ Just fp else return Nothing getURI :: Conf -> URI -> FilePath -> IO (Maybe FilePath) getURI conf url path = do createMissingDir dir hPutStr stderr "<" TOD now _ <- getClockTime TOD mt _ <- defaultModificationTime path TOD urlMT _ <- defaultModificationTime urlFP -- negative caching let current = now - (max mt urlMT) < maxAge conf unless current $ getImpl mbFileExists path where dir = getDir path urlFP = dir ++ "/" ++ escapeURI url getImpl = do let cmd = ("curl":[]++ words "-A curl-searchpath -s -L -f" ++ [url, "-o", path]) ret <- rawSystem (head cmd) (tail cmd) case ret of ExitSuccess -> hPutStr stderr ">" ExitFailure 22 -> writeFile urlFP "" >> --negative cache hPutStr stderr " " -- 4xx, 5xx _ -> hPutStr stderr $ "!" ++ url modListify = words . tr '.' ' ' dropSuffix path = if '.' `elem` path then reverse $ tail $ dropWhile (/='.') $ reverse path else path modChase = moduleChase Set.empty moduleChase::Set.Set [FilePath] -> Conf -> FilePath -> IO ((Set.Set [FilePath],MLSet),Maybe FilePath) moduleChase done conf hsFile' = do --handling remote hs files fe <- doesFileExist hsFile' mbHsFile <- if fe then return $ Just ((Just $ vTime conf,ModDir hsFile'),hsFile') else do isTodo conf $ modListify $ dropSuffix hsFile' if isNothing mbHsFile then return ((done,Set.empty),Nothing) else do let ((mbT,modLoc),hsFile) = fromJust mbHsFile --get import list importList <- getFileImports hsFile let imports = filter notDone $ map modListify $ unique importList notDone = (not . flip Set.member done) done' = Set.union done $ Set.fromList imports --convert imports to see if they are in the base and then find in any of those locations if not try retrieving todo <- mapM (isTodo conf) imports >>= return . map fromJust . filter isJust let usedTodo = Set.fromList $ map fst todo::MLSet base = ((done',usedTodo),hsFile) f ((done,used),_) ((mbT,_),hsFile) = do ((d2,used2),_) <- moduleChase done conf {vTime = maybe (vTime conf) id mbT} hsFile return ((Set.union done d2,Set.union used2 used),hsFile) ((done'',used),_) <- foldM f base todo return ((done'',used),return hsFile) -- so we can handle remote files! type MLSet = Set.Set (Maybe TimeDiff,ModLoc) mbSumIO f = foldl (\mbVal item->maybe (f item) (return . Just) =<< mbVal) (return Nothing) unique = map head . group . sort -- !! if istodo returns a Just file then also return the timestamp of the mod used -- use that timestamp in recursive calls from that point -- filter mbT > conf {vTime} isTodo conf imp = mbSumIO isTodo'' (modLocs conf) where slashed ="/"++(concat $ intersperse "/" imp) isTodo'' m@(mbT,mod) = do if (isJust mbT) && fromJust mbT > vTime conf then return Nothing else do x<-isTodo' mod --print mod debug 2 conf "ISTODO?" $ print mod >> print x ret x where ret = return . fmap (\x->(m,x)) -- add back the timestamp if present isTodo' (ModDir dir) = do let fp = dir ++ slashed return . msum =<< mapM (mbFileExists . (fp++) ) sourceExts isTodo' (ModURI mapdir ms uri) = do if not $ ms `isPrefixOf` imp then return Nothing else do mbSumIO (getFile . (slashed++)) sourceExts where getFile slashed = do let fp = mapdir ++ slashed::String getURI conf (uri++slashed) fp isTodo' mod@(ModTGZ mapdir ms uri mbBuild baseDir) = do if not $ ms `isPrefixOf` imp then return Nothing else do cwd <- getCurrentDirectory let repodir = mapdir ++ '/':escapeURI uri tgz = repodir ++ "/" ++ escapeURI uri fe <- doesFileExist tgz TOD t1 _ <- if fe then getModificationTime tgz else return $ TOD 0 0 mb <- getURI conf uri tgz debug 1 conf ("Retrieved " ++ uri) $ print mb if isNothing mb then return Nothing else do TOD t2 _ <- getModificationTime tgz when (t2-t1> maxAge conf) $ do setCurrentDirectory repodir let cmd = "tar -xzf "++escapeURI uri getCurrentDirectory >>= print --print cmd sys $ words cmd when (isJust mbBuild) $ do (doCmds $ fromJust mbBuild) >> return () setCurrentDirectory cwd let fp = repodir ++ "/" ++ baseDir ++ slashed mapM (mbFileExists . (fp++)) sourceExts >>= return . msum isTodo' (ModRepo mapdir ms repoCmd baseDir) = do if not $ ms `isPrefixOf` imp then return Nothing else do cwd <- getCurrentDirectory let repodir = mapdir ++ '/':escapeURI repoCmd de <- doesDirectoryExist repodir -- !!! handle if we should try to wipe and pull this repo again? unless de $ do createMissingDir repodir setCurrentDirectory repodir --print repoCmd doCmds repoCmd --sys $ words repoCmd -- !!!! handle failure!? setCurrentDirectory cwd let fp = repodir ++ "/" ++ baseDir ++ slashed mapM (mbFileExists . (fp++)) sourceExts >>= return . msum toCmds c = filter (\x->head x `elem` vcs) $ map words $ lines $ tr ';' '\n'c doCmds = mapM sys . toCmds readFile' x = catch (readFile x) (\_->return "") getFileImports fileName = fmap (getImports isLit) (readFile' fileName) where isLit = ".lhs" `isSuffixOf` fileName moduleRE = mkRegex "^[ \t]*module[ \t]+([^ \t\n\r]+).*$" importRE = mkRegex "^[ \t]*import[ \t]+(qualified[ \t]+)?([^()\n\r \t]+).*$" type ModuleName = String getImports :: Bool -> String -> [ModuleName] getImports isLit = altParse isLit 1 importRE altParse :: MonadPlus m => Bool -> Int -> Regex -> String -> m ModuleName altParse isLit ex re = msum . fmap (maybe mzero (return . (!! ex)) . matchRegex re) . parseLines isLit fnMap fs x = fmap (\f->f x) fs --parseLines :: String -> [String] parseLines isLit = fmap stripComments . concatMap lines . fnMap [id, unLit isLit,unLatex] --unLit :: String -> String unLit True src = unlines $ map tail $ filter (isPrefixOf ">") $ lines src unLit _ src = src unLatex :: String -> String unLatex src = impl id src where impl code src | null src = code "" | isPrefixOf beginCode src = impl (\x->code $ newCode ++ x) (drop codeLen src) | otherwise = impl code (tail src) codeLen = untilPrefix endCode 0 $ drop lenBeginCode src newCode = take codeLen $ drop lenBeginCode src beginCode="\\begin{code}" lenBeginCode = length beginCode endCode = "\\end{code}" stripComments :: String -> String stripComments src = impl "" src where impl code src | null src = reverse code | isPrefixOf "{-" src = impl code $ after "-}" src | isPrefixOf "--" src = impl code $ after "\n" src | otherwise = impl (head src:code) (tail src) untilPrefix prefix size [] = size untilPrefix prefix size src = if isPrefixOf prefix src then size else untilPrefix prefix (size+1) $ tail src after prefix [] = [] after prefix src = if isPrefixOf prefix src then drop (length prefix) src else after prefix $ tail src