Planet Haskell

By · rebuilding

sortBy :: (a -> a -> Ordering) -> [a] -> [a]
maximumBy :: (a -> a -> Ordering) -> [a] -> a
groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
nubBy :: (a -> a -> Bool) -> [a] -> [a]

sortOn :: (Ord b) => (a -> b) -> [a] -> [a]
maximumOn :: (Ord b) => (a -> b) -> [a] -> a
groupOn :: (Eq b) => (a -> b) -> [a] -> [[a]]
nubOn :: (Eq b) => (a -> b) -> [a] -> [a]

{-# LANGUAGE ForeignFunctionInterface #-}

module Win32.Kernel32 (getComputerName) where

import Control.Monad (when, unless)
import Data.Bits ((.|.))
import Foreign.Marshal.Alloc (alloca)
import Foreign.Ptr (nullPtr)
import Foreign.Storable (peek, poke)
import System.Win32.Types (DWORD, LPDWORD, LPTSTR, LPVOID,
                           peekTStringLen, peekTString, withTString)

#include <windows.h>
#include
kernel32.dll
foreign import stdcall unsafe "GetComputerNameW"
  win32_getComputerName :: LPTSTR -> LPDWORD -> IO Bool

foreign import stdcall unsafe "GetLastError"
  win32_getLastError :: IO DWORD

foreign import stdcall unsafe "FormatMessageW"
  win32_formatMessage :: DWORD
                      -> LPVOID
                      -> DWORD
                      -> DWORD
                      -> LPTSTR
                      -> DWORD
                      -> LPVOID
                      -> IO DWORD
getComputerName :: IO String
getComputerName =
  withTString maxBuf $
    \buf ->
      alloca $ \len -> do
        poke len (fromIntegral maxLength)

        success <- win32_getComputerName buf len
        unless success $ failWithLastError "GetComputerName"

        len' <- peek len
        peekTStringLen (buf, (fromIntegral len'))
  where
    maxBuf = replicate maxLength '\0'
    maxLength = #const MAX_COMPUTERNAME_LENGTH
#const
MAX_COMPUTERNAME_LENGTH
failWithLastError :: String -> IO a
failWithLastError name = do
  code <- win32_getLastError
  withTString errbuf $
    \buf -> do
      gotmsg <- win32_formatMessage flags
                                    nullPtr
                                    code
                                    lang
                                    buf
                                    (fromIntegral errlen)
                                    nullPtr
      fmtcode <- win32_getLastError
      when (gotmsg == 0) $
        fail $ name ++ " failed: " ++ show (code, fmtcode)

      msg <- peekTString buf
      fail $ name ++ ": " ++ filter notEOL msg
  where
    errbuf = replicate errlen '\0'
    errlen = 300
    flags = #const FORMAT_MESSAGE_FROM_SYSTEM
            .|.
            #const FORMAT_MESSAGE_IGNORE_INSERTS
    lang = 0
    notEOL c = c /= '\n' && c /= '\r'
$ cabal test
test: user error (GetComputerName: The file name is too long.)
Kernel32.hsc
.hsc
Library
  hs-source-dirs:  src
  exposed-modules: Win32.Kernel32
  build-depends:   base, Win32
  extensions:      ForeignFunctionInterface
  ghc-options:     -Wall
cabal configure -ftest
cabal build
cabal test
@inproceedings{OdeToProlog,
 author = "Ralf L{\"a}mmel",
 title = "{Scrap Your Boilerplate---Prologically!}",
 booktitle = "Proceedings of the 11th ACM SIGPLAN international conference on Principles and practice of declarative programming",
 publisher = ACM,
 year = 2009,
 note = "6 pages"
}

Build-Type: Custom

...

flag test
  description: Build test program.
  default:     False

Executable test
  hs-source-dirs:  src, test
  other-modules:   MyModule1, MyModule2
  main-is:         Main.hs
  build-depends:   base
  if !flag(test)
    buildable:     False
cabal configure -ftest
test
Setup.hs
main = defaultMainWithHooks hooks
  where hooks = simpleUserHooks { runTests = runTests' }

runTests' :: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()
runTests' _ _ _ lbi = system testprog >> return ()
  where testprog = (buildDir lbi) </> "test" </> "test"
cabal test
test/Main.hs
-ftest
phred
x + y
x `append` y
x in y
x `isInfixOf` y
x < y
x < y
x <= y
x <= y
x == y
x == y
x != y
x /= y
x > y
x > y
x >= y
x >= y
x % (...)

x[i] 
x `index` i
x[i:j]
(j-i) `take` (i `drop` x)
hash(x)

len(x)
length x
x * y
y `replicate` x
x.capitalize()

x.center(y)

x.count()

x.decode()
decode...
x.encode()
encode...
x.endswith(y)
y `isSuffixOf` x
x.expandtabs()

x.find(y)

x.format(...)

x.index(y)

x.isalnum()
all isAlphaNum x
x.isalpha()
all isAlpha x
x.isdigit()
all isDigit x
x.islower()
all isLower x
x.isspace()
all isSpace x
x.istitle()

x.isupper()
all isUpper x
x.join(y)
intercalate x y
x.ljust(w)

x.lower()
toLower x
x.lstrip()
dropWhile isSpace
x.partition(y)
break (==y) x
x.replace(y,z)

x.rfind(y)

x.rindex(y)

x.rjust(y)

x.rpartition(y)

x.rsplit(y)

x.rstrip(y)

x.split(y)

x.splitlines()
lines x
x.startswith(y)
y `isPrefixOf` x
x.strip()

x.swapcase()

x.title()

x.translate(y)

x.upper()
toUpper x
x.zfill()

unicodedata
string
format
Data.Text
Data.Text.Legacy
Data.Text
split :: Char -> Text -> [Text]
split :: Text -> Text -> [Text]
:info
-ddump-minimal-imports
M.imports
module Main where

import Control.Arrow
import Control.Monad
import Data.Char
import Data.List
import Data.Map hiding (filter, map)
import System.Environment
import System.Exit
import System.IO

usage :: IO a
usage = do
  me <- getProgName
  hPutStrLn stderr $ "Usage: " ++ me ++ " [ dictionary ]"
  exitWith (ExitFailure 1)

main :: IO ()
main =
  getPath >>= readFile >>= mapM_ (putStrLn . unwords) . sorted
  where sorted = sort . map sort . anagrams . lines

anagrams :: [String] -> [[String]]
anagrams words = filter ((>1) . length) equiv
  where equiv = elems $
                  fromListWith (++)
                    [ (normal w, [w]) | w <- words ]
        normal = sort . map toLower

getPath :: IO FilePath
getPath = getArgs >>= go
  where go [path] = return path
        go []     = return "/usr/share/dict/words"
        go _      = usage
$ ghc-6.10.3 -ddump-minimal-imports --make anagram.hs 
$ cat Main.imports
import System.IO(IO, FilePath, putStrLn, readFile, hPutStrLn,
                 stderr)
import Data.Map(elems, fromListWith)
import Control.Arrow()    -- Instances only
import Control.Monad(Monad(return, (>>=)), mapM_)
import Data.Char(String, toLower)
import Data.List((++), filter, map, length, lines, unwords, sort)
import System.Environment(getArgs, getProgName)
import System.Exit(ExitCode(ExitFailure), exitWith)
map (normal &&& (:[])) words
-ddump-minimal-imports

Python	Haskell
`x + y`	x `append` y
`x in y`	x `isInfixOf` y
`x < y`	`x < y`
`x <= y`	`x <= y`
`x == y`	`x == y`
`x != y`	`x /= y`
`x > y`	`x > y`
`x >= y`	`x >= y`
`x % (...)`
`x[i]`	x `index` i
`x[i:j]`	(j-i) `take` (i `drop` x)
`hash(x)`
`len(x)`	`length x`
`x * y`	y `replicate` x
`x.capitalize()`
`x.center(y)`
`x.count()`
`x.decode()`	`decode...` family
`x.encode()`	`encode...` family
`x.endswith(y)`	y `isSuffixOf` x
`x.expandtabs()`
`x.find(y)`
`x.format(...)`
`x.index(y)`
`x.isalnum()`	`all isAlphaNum x`
`x.isalpha()`	`all isAlpha x`
`x.isdigit()`	`all isDigit x`
`x.islower()`	`all isLower x`
`x.isspace()`	`all isSpace x`
`x.istitle()`
`x.isupper()`	`all isUpper x`
`x.join(y)`	`intercalate x y`
`x.ljust(w)`
`x.lower()`	`toLower x`
`x.lstrip()`	`dropWhile isSpace`
`x.partition(y)`	`break (==y) x`
`x.replace(y,z)`
`x.rfind(y)`
`x.rindex(y)`
`x.rjust(y)`
`x.rpartition(y)`
`x.rsplit(y)`
`x.rstrip(y)`
`x.split(y)`
`x.splitlines()`	`lines x`
`x.startswith(y)`	y `isPrefixOf` x
`x.strip()`
`x.swapcase()`
`x.title()`
`x.translate(y)`
`x.upper()`	`toUpper x`
`x.zfill()`

Planet Haskell

Holden Karau: Your browser history is showing (an open source web application in scheme)

Michael Snoyman: Hack sample- chat server

Luke Palmer: On the By functions

Magnus Therning: Dataenc finally making it into Debian

Thomas ten Cate: New build instructions

Erik de Castro Lopo: Three More for the Debian New Queue.

Greg Bacon: FFI: calling into kernel32.dll

Ralf Lammel: SYB goes Prolog

Scrap Your Boilerplate---Prologically!

Arch Haskell News: Arch Haskell News: June 30 2009

Notable Updates

Galois, Inc: Tech Talk: The Fleet Architecture

Greg Bacon: Setting up a simple test with Cabal

Philip Wadler: Pictures created from food

Ketil Malde: Dephd updates

Bryan O'Sullivan: What’s in a text API?

Tom Moertel: Dear Jeff Bezos: Here's an easy, effective way to fix the production problems in Amazon Kindle-edition books and, at the same time, prove that the Kindle is really, truly better than paper

The Good

The Bad

The brilliant fix (no need to thank me, Mr. Bezos)

DEFUN 2009: DEFUN and CUFP 2009 registration are now open!

Brent Yorgey: 2009 ICFP programming contest reflections

Haskell Weekly News: Haskell Weekly News: June 29, 2009

Announcements

Discussion

Blog noise

Quotes of the Week

About the Haskell Weekly News

Galois, Inc: Galois, Inc. Wins Two Small Business Research Awards from Federal Agencies

DHS Topic: Highly Scalable Identity Management Tools

DOE Topic: Grid 2.0: Collaboration and Sharing on the Grid

About Galois, Inc.

Greg Bacon: Cleaning up your Haskell imports