From ef19913d068fda500962542191b1a53e3067a3b5 Mon Sep 17 00:00:00 2001
From: Adam Vogt <vogt.adam@gmail.com>
Date: Mon, 12 Oct 2009 06:49:18 +0200
Subject: Update D.Extending module lists with help of a script (also added)

Ignore-this: c280d3047355be962e8ef706d598aa43

darcs-hash:20091012044918-1499c-9761fe0833b9ad47cd65bfd70059b6bb64d2c59c.gz
---
 scripts/grabDescriptions.hs | 37 +++++++++++++++++++++++++++++++++++++
 1 file changed, 37 insertions(+)
 create mode 100755 scripts/grabDescriptions.hs

(limited to 'scripts')

diff --git a/scripts/grabDescriptions.hs b/scripts/grabDescriptions.hs
new file mode 100755
index 0000000..f6c0bbf
--- /dev/null
+++ b/scripts/grabDescriptions.hs
@@ -0,0 +1,37 @@
+#!/usr/bin/env runhaskell
+
+import Control.Applicative
+import Control.Arrow
+import Control.Monad
+import Data.Char
+import Data.List
+import Data.Maybe
+import System.Directory
+import System.Environment
+
+-- needs haskell-src-exts
+import qualified Language.Haskell.Exts.Annotated as H
+
+getComments = (fmap . fmap) (map (\(H.Comment _ _ x) -> x) . snd)
+            . H.parseFileWithComments H.defaultParseMode
+
+-- | Used to grab the description fields from all the modules in the current
+-- directory for updating XMonad.Docs.Extending
+main = putStrLn . intercalate "\n"
+    =<< mapM (fmap . handleFailure description <*> getComments) =<< filterM doesFileExist . sort
+    =<< getDirectoryContents . fromMaybe "." . listToMaybe
+    =<< getArgs -- somehow only the "." fallback works...
+
+handleFailure :: (String -> [String] -> String) -> String -> H.ParseResult [String] -> String
+handleFailure f n (H.ParseOk x) = f n x
+handleFailure f n (H.ParseFailed _ msg) = n ++ " Parse Failure: " ++ msg
+
+description :: String -> [String] -> String
+description path xs =
+    let (hs,desc)
+            = uncurry (\x (y,descr) -> (x++y,takeWhile (not . or . sequence [null,("* Usage" `isInfixOf`),all (=='-'),all isSpace]) . dropWhile (all isSpace) $ descr))
+            . second (splitAt 1)
+            . break (isPrefixOf "Portability")
+            . map (dropWhile isSpace) $ concatMap lines xs
+        modName = maybe path (takeWhile (not . isSpace) . dropWhile isSpace . drop 1 . dropWhile (/=':')) $ find ("Module" `isInfixOf`) hs
+    in "* \""++modName++"\":\n"++unlines (map ("    "++) desc)
-- 
cgit v1.2.3