include all the other random files I had floating around

Author: gwern

bandwidth.hs

@@ -0,0 +1,39 @@
+import Data.Maybe (fromJust)
+import Distribution.PackageDescription
+import Distribution.PackageDescription.Parse
+import Control.Monad (unless)
+
+main :: IO ()
+main = do cbl <- getContents
+          let desc = parsePackageDescription cbl
+          case desc of
+            ParseFailed _ -> return ()
+            ParseOk _ d -> do let repos = repoPair $ extractHead $ extractRepos d
+                              let cmd = concatMap shellify repos
+                              unless (null cmd) $ putStrLn cmd
+
+shellify :: (RepoType, String) -> String
+shellify (rt,url) = case rt of
+                       Darcs -> "darcs get " ++ url
+                       Git -> "git clone " ++ url
+                       SVN -> "svn clone " ++ url
+                       CVS -> "cvs co " ++ url
+                       Mercurial -> "hg clone " ++ url
+                       _ -> ""
+
+repoPair :: [SourceRepo] -> [(RepoType, String)]
+repoPair = map (\x -> (fromJust $ repoType x, fromJust $ repoLocation x))
+
+extractHead :: [SourceRepo] -> [SourceRepo]
+extractHead rs = filter (\x -> isnothing x && ishead x) rs
+                where ishead sr = case repoKind sr of
+                        RepoHead -> True
+                        _ -> False
+                      isnothing ss = case repoType ss of
+                                       Nothing -> False
+                                       Just _ -> case repoLocation ss of
+                                                     Nothing -> False
+                                                     Just _ -> True
+
+extractRepos :: GenericPackageDescription -> [SourceRepo]
+extractRepos = sourceRepos . packageDescription

d.hs

@@ -0,0 +1,31 @@
+import qualified Data.Data
+import Language.Haskell.Exts
+import qualified Data.Foldable as F (concat)
+import Data.Generics.Uniplate.Data
+import qualified Data.Map as M
+import Data.List
+import Data.Ord
+
+main :: IO ()
+main = do args <- fmap lines getContents
+          db <- fmap (M.unionsWith (+)) $ mapM checkAndCount args
+          print $ map show $ sortBy (comparing snd) $ M.toList db
+
+checkAndCount :: FilePath -> IO (M.Map String Int)
+checkAndCount   f  = do putStrLn f
+                        x <- readFile f
+                        let exts = F.concat $ readExtensions x
+                        let parsed = parseFileContentsWithMode
+                                       (defaultParseMode {fixities = fixes, extensions = exts}) x
+                        case parsed of
+                         ParseFailed _ _ -> return M.empty
+                         ParseOk a -> return (functionSearch a)
+
+-- the default fixities augmented with everything necessary to parse my corpus
+fixes :: Maybe [Fixity]
+fixes = Just $ baseFixities ++ infixr_ 0 ["==>", "#", ">==",">>==", ">.", "$$"]
+
+functionSearch :: Data.Data.Data from => from -> M.Map String Int
+functionSearch md = do
+ let xs = [ a | Var (UnQual (Ident a)) <- universeBi md]
+ M.fromListWith (+) $ zip xs (repeat 1) -- map (M.insertWith (+) xs 1 $ M.empty)

deletelines.hs

@@ -0,0 +1,113 @@
+{-# LANGUAGE GADTs, RankNTypes #-}
+--
+data Term x where
+    K :: Term (a -> b -> a)
+    S' :: Term ((a -> b -> c)  -> (a -> b) -> a -> c)
+    Const :: a -> Term a
+    (:@) :: Term (a -> b) -> (Term a) -> Term b
+infixl 6 :@
+
+eval'::Term a -> Term a
+eval' (K :@ x :@ y) = x
+eval' (S' :@ x :@ y :@ z) = x :@ z :@ (y :@ z)
+eval' x = x
+
+--
+
+data Term' x where
+     E :: (Integral a => a -> Bool) -> Term' (Integral a => a -> Bool)
+     N :: Int -> Term' Int
+     Q :: Int -> (Integral a => a -> Bool) -> Term' ((Integral a => a -> Bool), Int)
+
+eval :: Term' x -> x
+eval (N x) = x
+--eval (E x) = x
+-- eval (Q (x,y)) = eval x $ eval y
+
+foo :: Bool
+foo = eval (Q odd 1)
+
+-- data S x where
+--     Ns :: S [Int]
+--     Eval :: S (Int -> Bool)
+--     Map :: S ([Int] -> S a -> Bool)
+--     Even :: S (Int -> Bool)
+--     IsPrime :: S (Int -> Bool)
+--     Expr :: S (a, b)
+
+-- eval :: S x -> S x
+-- eval (Expr (Even, Ns) = map isEven (
+-- eval x = x
+
+--
+-- data Singleton a where
+--     Even :: Singleton (Int -> Bool)
+--     Odd :: Singleton (Int -> Bool)
+--     Prime :: Singleton (Int -> Bool)
+-- --    Const' :: [Int] -> Singleton [Int]
+
+-- eval'
+
+-- data Span a where
+--  Map :: Span (Singleton a -> [Int] -> Bool)
+
+
+-- data Boolean a where
+--    Not :: Boolean (Bool -> Bool)
+--    Xor :: Boolean (Bool -> Bool -> Bool)
+-- 
+--  -- BTW, type signatures are mandatory if you're using GADTs
+-- translate :: Singleton a -> a
+-- translate a = case a of 
+--                Even -> not . odd
+--                Odd -> odd
+--                Prime -> isPrime
+
+
+-- functions :: [Function a] -> [a]
+-- functions = map translate
+-- 
+-- eval :: [a] -> [Function (a -> Bool)] -> Bool
+-- eval nums exprs = and $ zipWith (\x y -> y x) nums $ functions exprs
+
+isPrime :: Int -> Bool
+isPrime n = aux primes
+    where
+      aux ps | head ps < n = aux $ tail ps
+             | head ps == n = True
+             | otherwise = False
+      primes :: [Int]
+      primes = sieve [2..]
+      sieve (p:xs) = p : sieve [x | x <- xs, x `mod` p /= 0]
+      sieve [] = undefined
+
+{- -- apparently need GADTs for this... http://haskell.org/haskellwiki/GADT
+data Function = Fold |
+                Prime | Composite |
+                Subtract | Add | Multiply | Divide | Exponent |
+                GreaterThan | LessThan 
+
+foo xs y = zipWith ($) (map translateUnadic' xs) y
+ 
+-- translate :: Function ->[Int] -> Bool
+translateUnadic Not  = not
+translateUnadic' Even = not . odd
+translateUnadic' Odd = odd
+
+translateUnadic'' Prime = isPrime
+translateUnadic'' Composite = not . isPrime
+
+translate And  = (&&)
+translate Or  = (||)
+-- translate Xor  = xor
+
+translate' Fold = \x y -> foldr x 0 y
+
+translate'' Subtract = (-)
+translate'' Add = (+)
+-- translate'' = 
+
+xor :: Bool -> Bool -> Bool
+xor x y = (x &&not y) || (y ||not x)
+
+-}

deps.hs

@@ -0,0 +1,27 @@
+import System.Environment (getArgs)
+import Language.Haskell.Exts
+import qualified Data.Foldable as F (concat)
+import Data.Generics.Uniplate.Data
+
+main :: IO ()
+main = do (func:_) <- getArgs
+          args <- fmap lines $ getContents
+          imports <- join $ mapM parseForImports args
+          -- insert each import module into the IntMap
+          -- print out IntMap sorting by module (descending order)
+
+parseForImports :: String -> FilePath -> IO [Imports]
+parseForImports fn fs = do print fs
+                         x <- readFile fs
+                         let exts = F.concat $ readExtensions x
+                         let parsed = parseFileContentsWithMode (defaultParseMode { fixities = fixes, extensions = exts }) x
+                         case parsed of
+                          ParseFailed _ _ -> (return [])
+                          ParseOk a -> return $ moduleCount a
+            where -- the default fixities augmented with everything necessary to parse my corpus
+                  fixes :: [Fixity]
+                  fixes = baseFixities++[Fixity AssocRight 0 (VarOp (Symbol "==>"))]
+
+functionSearch :: Module -> [Imports]
+functionSearch md = do undefined
+--  let x = length [ () | Var (UnQual (Ident a)) <- universeBi md, a == fun]

echelon.hs

@@ -0,0 +1,29 @@
+import System.Environment (getArgs)
+import Language.Haskell.Exts
+import qualified Data.Foldable as F (concat)
+import Data.Generics.Uniplate.Data
+-- import Debug.Trace
+
+main :: IO ()
+main = do (func:_) <- getArgs
+          args <- fmap lines $ getContents
+          mapM_ (checkAndPrint func) args
+
+checkAndPrint :: String -> FilePath -> IO ()
+checkAndPrint fn fs = do print fs
+                         x <- readFile fs
+                         let exts = F.concat $ readExtensions x
+                         let parsed = parseFileContentsWithMode (defaultParseMode { fixities = fixes, extensions = exts }) x
+                         case parsed of
+                          ParseFailed _ _ -> (return ())
+                          ParseOk a -> functionSearch fn a
+                         return ()
+
+-- the default fixities augmented with everything necessary to parse my corpus
+fixes :: Maybe [Fixity]
+fixes = Just $ baseFixities ++ infixr_ 0 ["==>"]
+
+functionSearch :: String -> Module -> IO ()
+functionSearch fun md = do
+  let x = length [ () | Var (UnQual (Ident a)) <- universeBi md, a == fun]
+  putStrLn $ "Found " ++ show x ++ " occurences of function " ++ fun

function-counter.hs

@@ -0,0 +1,21 @@
+{-
+write function-based search:
+   Example code: `(find-fn 1 2 3) -> [clojure.add]`; `(+ 1 2) -> 3`
+   but there are lots of `Int -> Int -> Int` functions! So it returns multiple results:
+   it answers `2 2 4` with `[clojure.core/unchecked-multiply clojure.core/+ clojure.core/* clojure.core/unchecked-add]` (since 2*2=4 and 2+2=4)
+   it searches based on the function running in a jailed environment for that reason
+   in haskell: Lambdabot already does type inference, type searching, and safe evaluation, so your 1 2 3 example would go like split on whitespace, map a :t type-inferrer, run a Hoogle search on x -> y -> ... -> z, and evaluate using the first _n_ hits and print out all the ones that didn't error out up to _x_ successes
+-}
+import System.Environment
+
+main = do args <- getArgs
+          exprs <- mapM (\foo -> spawn $ "ghc -e \':type " ++ foo ++ " | tail -1")
+          let paramtypes = map (drop 2 $ takeWhile (\x -> x /= ':')) exprs
+          let ftype = concat $ intersperse " -> " paramtypes
+          functions <- fmap lines $ spawn $ "hoogle '" ++ x ++ "'"
+          eval functions (concat args)
+          where eval :: [String] -> String -> IO ()
+                eval (f:fs) args = do (status,res) <- spawn $ "mueval -e " ++ f ++ args
+                                      case status of
+                                        Succeeded -> print (f ++ " " ++ res)
+                                        Failed -> eval fs args

game.hs

@@ -0,0 +1,22 @@
+import Graphics.XOSD
+import Control.Concurrent (threadDelay)
+import Data.Time.Clock (getCurrentTime)
+import Data.Time.Format (formatTime)
+import System.Locale (defaultTimeLocale)
+
+main :: IO ()
+main = do threadDelay tenminutes
+          time <- getCurrentTime
+          let time' = formatTime defaultTimeLocale "%R" time
+          runXOSD [ Timeout 2
+                   , VAlign VAlignTop
+                   , HAlign HAlignRight
+                   , Font "-*-dejavu sans mono-medium-r-*-*-17-*-*-*-*-*-*-*"
+                   , Color "LimeGreen"
+                   , Display (String time')] 
+                   (const $ return ())
+          main
+           where second = 1000
+                 minute = second * 60
+                 tenminutes = 10 * minute
+