samhuri.net


By Sami Samhuri

June 2007

Controlling volume via the keyboard on Linux

I was using Amarok's global keyboard shortcuts to control the volume of my music via the keyboard but I wanted to control the system volume as well. A quick script later and now I can control both, and thanks to libnotify I get some feedback on what happened. It's not as pretty as OS X's volume control or Growl but it'll certainly do.

↓ Download volume.rb

I save this as ~/bin/volume and call it thusly: volume + and volume -. I bind Alt-+ and Alt—to those in my fluxbox config. If you don't have a preferred key binding program I recommend trying xbindkeys. apt-get install, emerge, paludis -i, or rpm -i as needed.

Recent Ruby and Rails Regales

Some cool Ruby and [the former on] Rails things are springing up and I haven't written much about the two Rs lately, though I work with them daily.

Rails on Rules

My friend Jim Roepcke is researching and implementing a plugin/framework designed to work with Rails called Rails on Rules. His inspiration is the rule system from WebObjects' Direct to Web. He posted a good example for me, but this baby isn't just for template/view logic. If some of the Rails conventions were specified in a default set of rules which the developer could further customize then you basically have a nice way of doing things that you would otherwise code by hand. I think it would be a boon for the ActiveScaffold project. We're meeting up to talk about this soon and I'll have more to say after then, but it sounds pretty cool.

Sake Bomb!

I've noticed a trend among some recent posts about Rake: the authors keep talking about booze. Are we nothing but a bunch of booze hounds?! Well one can hope. There's some motivation to learn more about a tool, having more time to drink after work. This week Chris Wanstrath dropped a Sake Bomb on the Ruby community. Like piston, sake is something you can just pick up and use instantly. Interestingly the different pronunciations of rake and sake help me from confusing the two on the command line... so far.

Secure Associations (for Rails)

Jordan McKible

released the secure_associations plugin. It lets you protect your models' *_id attributes from mass-assignment via belongs_to_protected and has_many_protected. It's a mild enhancement, but an enhancement nonetheless. This is useful to enough people that it should be in Rails proper.

Regular expressions and strings with embedded objects

taw

taught me a new technique for simplifying regular expressions by transforming the text in a reversible manner. In one example he replaced literal strings in SQL - which are easily parsed via a regex - with what he calls embedded objects. They're just tokens to identify the temporarily removed strings, but the important thing is that they don't interfere with the regexes that operate on the other parts of the SQL, which would have been very difficult to get right with the strings inside it. If I made it sound complicated just read the post, he explains it well.

If you believe anything Steve Yegge says then that last regex trick may come in handy for Q&D parsing in any language, be it Ruby, NBL, or whataver.

Emacs: tagify-region-or-insert-tag

After axing half of wrap-region.el I renamed it to tagify.el and improved it ever so slightly. It's leaner, and does more!

tagify-region-or-insert-tag

does the same thing as wrap-region-with-tag except if there is no region it now inserts the opening and closing tags and sets point in between them. I have this bound to C-z t, as I use C-z as my personal command prefix.

<

is bound to tagify-region-or-insert-self which really doesn't warrant an explanation.

RTFM!

I should read the Emacs manual sometime, especially since I have it in dead-tree form. Check out skeleton pairs in the Emacs manual, or better yet C-h f skeleton-pair-insert-maybe. skeleton-pair has already been massaged to do what you most likely want if you set the correct options. Cool. I like Emacs more every day.

This renders wrap-region useless, which is great! I like a trim .emacs and .emacs.d.

Propaganda makes me sick

Things like this in modern times are surprising. Can't people spot this phony crap for what it is?

First they put away the dealers, keep our kids safe and off the streets
Then they put away the prostitutes, keep married men cloistered at home
Then they shooed away the bums, and they beat and bashed the queers
Turned away asylum-seekers, fed us suspicions and fears
We didn't raise our voice, we didn't make a fuss
It´s funny there was no one left to notice, when they came for us

Looks like witches are in season, you better fly your flag and be aware
Of anyone who might fit the description, diversity is now our biggest fear
Now with our conversations tapped, and our differences exposed
How ya supposed to love your neighbour, with our minds and curtains closed?
We used to worry 'bout big brother
Now we got a big father and an even bigger mother


And still you believe, this aristocracy gives a fuck about you
They put the mock in democracy, and you swallowed every hook
The sad truth is, you'd rather follow the school into the net
'Cause swimming alone at sea, is not the kind of freedom that you actually want
So go back to your crib, and suck on a tit
Bask in the warmth of your diaper, you're sitting in shit
And piss, while sucking on a giant pacifier
A country of adult infants, a legion of mental midgets
A country of adult infants, a country of adult infants
All regaining their unconsciousness

—from the song Regaining Unconsciousness, by NOFX

Floating point in ElSchemo

Parsing floating point numbers

The first task is extending the LispVal type to grok floats.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
type LispInt = Integer
type LispFloat = Float

-- numeric data types
data LispNum = Integer LispInt
             | Float LispFloat

-- data types
data LispVal = Atom String
             | List [LispVal]
             | DottedList [LispVal] LispVal
             | Number LispNum
             | Char Char
             | String String
             | ...

The reason for using the new LispNum type and not just throwing a new Float Float constructor in there is so that functions can accept and operate on parameters of any supported numeric type. First the floating point numbers need to be parsed. For now I only parse floating point numbers in decimal because the effort to parse other bases is too great for the benefits gained (none, for me).

ElSchemo now parses negative numbers so I'll start with 2 helper functions that are used when parsing both integers and floats:

1
2
3
4
5
6
7
parseSign :: Parser Char
parseSign = do try (char '-')
           <|> do optional (char '+')
                  return '+'

applySign :: Char -> LispNum -> LispNum
applySign sign n = if sign == '-' then negate n else n
parseSign

is straightforward as it follows the convention that a literal number is positive unless explicitly marked as negative with a leading minus sign. A leading plus sign is allowed but not required.

applySign

takes a sign character and a LispNum and negates it if necessary, returning a LispNum.

Armed with these 2 functions we can now parse floating point numbers in decimal. Conforming to R5RS an optional #d prefix is allowed.

1
2
3
4
5
6
7
8
parseFloat :: Parser LispVal
parseFloat = do optional (string "#d")
                sign <- parseSign
                whole <- many1 digit
                char '.'
                fract <- many1 digit
                return . Number $ applySign sign (makeFloat whole fract)
    where makeFloat whole fract = Float . fst . head . readFloat $ whole ++ "." ++ fract

The first 6 lines should be clear. Line 7 simply applies the parsed sign to the parsed number and returns it, delegating most of the work to makeFloat. makeFloat in turn delegates the work to the readFloat library function, extracts the result and constructs a LispNum for it.

The last step for parsing is to modify parseExpr to try and parse floats.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
-- Integers, floats, characters and atoms can all start with a # so wrap those with try.
-- (Left factor the grammar in the future)
parseExpr :: Parser LispVal
parseExpr = (try parseFloat)
        <|> (try parseInteger)
        <|> (try parseChar)
        <|> parseAtom
        <|> parseString
        <|> parseQuoted
        <|> do char '('
               x <- (try parseList) <|> parseDottedList
               char ')'
               return x
        <|> parseComment

Displaying the floats

That's it for parsing, now let's provide a way to display these suckers. LispVal is an instance of show, where show = showVal so showVal is our first stop. Remembering that LispVal now has a single Number constructor we modify it accordingly:

1
2
3
4
5
6
7
showVal (Number n) = showNum n

showNum :: LispNum -> String
showNum (Integer contents) = show contents
showNum (Float contents) = show contents

instance Show LispNum where show = showNum

One last, and certainly not least, step is to modify eval so that numbers evaluate to themselves.

eval env val@(Number _) = return val

There's a little more housekeeping to be done such as fixing integer?, number?, implementing float? but I will leave those as an exercise to the reader, or just wait until I share the full code. As it stands now floating point numbers can be parsed and displayed. If you fire up the interpreter and type 2.5 or -10.88 they will be understood. Now try adding them:

(+ 2.5 1.1) Invalid type: expected integer, found 2.5

Oops, we don't know how to operate on floats yet!

Operating on floats

Parsing was the easy part. Operating on the new floats is not necessarily difficult, but it was more work than I realized it would be. I don't claim that this is the best or the only way to operate on any LispNum, it's just the way I did it and it seems to work. There's a bunch of boilerplate necessary to make LispNum an instance of the required classes, Eq, Num, Real, and Ord. I don't think I have done this properly but for now it works. What is clearly necessary is the code that operates on different types of numbers. I think I've specified sane semantics for coercion. This will be very handy shortly.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70 
lispNumEq :: LispNum -> LispNum -> Bool
lispNumEq (Integer arg1) (Integer arg2) = arg1 == arg2
lispNumEq (Integer arg1) (Float arg2) = (fromInteger arg1) == arg2
lispNumEq (Float arg1) (Float arg2) = arg1 == arg2
lispNumEq (Float arg1) (Integer arg2) = arg1 == (fromInteger arg2)

instance Eq LispNum where (==) = lispNumEq

lispNumPlus :: LispNum -> LispNum -> LispNum
lispNumPlus (Integer x) (Integer y) = Integer $ x + y
lispNumPlus (Integer x) (Float y)   = Float $ (fromInteger x) + y
lispNumPlus (Float x)   (Float y)   = Float $ x + y
lispNumPlus (Float x)   (Integer y) = Float $ x + (fromInteger y)

lispNumMinus :: LispNum -> LispNum -> LispNum
lispNumMinus (Integer x) (Integer y) = Integer $ x - y
lispNumMinus (Integer x) (Float y)   = Float $ (fromInteger x) - y
lispNumMinus (Float x)   (Float y)   = Float $ x - y
lispNumMinus (Float x)   (Integer y) = Float $ x - (fromInteger y)

lispNumMult :: LispNum -> LispNum -> LispNum
lispNumMult (Integer x) (Integer y) = Integer $ x * y
lispNumMult (Integer x) (Float y)   = Float $ (fromInteger x) * y
lispNumMult (Float x)   (Float y)   = Float $ x * y
lispNumMult (Float x)   (Integer y) = Float $ x * (fromInteger y)

lispNumDiv :: LispNum -> LispNum -> LispNum
lispNumDiv (Integer x) (Integer y) = Integer $ x `div` y
lispNumDiv (Integer x) (Float y)   = Float $ (fromInteger x) / y
lispNumDiv (Float x)   (Float y)   = Float $ x / y
lispNumDiv (Float x)   (Integer y) = Float $ x / (fromInteger y)

lispNumAbs :: LispNum -> LispNum
lispNumAbs (Integer x) = Integer (abs x)
lispNumAbs (Float x) = Float (abs x)

lispNumSignum :: LispNum -> LispNum
lispNumSignum (Integer x) = Integer (signum x)
lispNumSignum (Float x) = Float (signum x)

instance Num LispNum where
    (+) = lispNumPlus
    (-) = lispNumMinus
    (*) = lispNumMult
    abs = lispNumAbs
    signum = lispNumSignum
    fromInteger x = Integer x


lispNumToRational :: LispNum -> Rational
lispNumToRational (Integer x) = toRational x
lispNumToRational (Float x) = toRational x

instance Real LispNum where
    toRational = lispNumToRational


lispIntQuotRem :: LispInt -> LispInt -> (LispInt, LispInt)
lispIntQuotRem n d = quotRem n d

lispIntToInteger :: LispInt -> Integer
lispIntToInteger x = x

lispNumLessThanEq :: LispNum -> LispNum -> Bool
lispNumLessThanEq (Integer x) (Integer y) = x <= y
lispNumLessThanEq (Integer x) (Float y)   = (fromInteger x) <= y
lispNumLessThanEq (Float x)   (Integer y) = x <= (fromInteger y)
lispNumLessThanEq (Float x)   (Float y)   = x <= y

instance Ord LispNum where (<=) = lispNumLessThanEq

Phew, ok with that out of the way now we can actually extend our operators to work with any type of LispNum. Our Scheme operators are defined using the functions numericBinop and numBoolBinop. First we'll slightly modify our definition of primitives:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
primitives :: [(String, [LispVal] -> ThrowsError LispVal)]
primitives = [("+", numericBinop (+)),
              ("-", subtractOp),
              ("*", numericBinop (*)),
              ("/", floatBinop (/)),
              ("mod", integralBinop mod),
              ("quotient", integralBinop quot),
              ("remainder", integralBinop rem),
              ("=", numBoolBinop (==)),
              ("<", numBoolBinop (<)),
              (">", numBoolBinop (>)),
              ("/=", numBoolBinop (/=)),
              (">=", numBoolBinop (>=)),
              ("<=", numBoolBinop (<=)),
              ...]

Note that mod, quotient, and remainder are only defined for integers and as such use integralBinop, while division (/) is only defined for floating point numbers using floatBinop. subtractOp is different to support unary usage, e.g. (- 4) => -4, but it uses numericBinop internally when more than 1 argument is given. On to the implementation! First extend unpackNum to work with any LispNum, and provide separate unpackInt and unpackFloat functions to handle both kinds of LispNum.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
unpackNum :: LispVal -> ThrowsError LispNum
unpackNum (Number (Integer n)) = return $ Integer n
unpackNum (Number (Float n)) = return $ Float n
unpackNum notNum = throwError $ TypeMismatch "number" notNum

unpackInt :: LispVal -> ThrowsError Integer
unpackInt (Number (Integer n)) = return n
unpackInt (List [n]) = unpackInt n
unpackInt notInt = throwError $ TypeMismatch "integer" notInt

unpackFloat :: LispVal -> ThrowsError Float
unpackFloat (Number (Float f)) = return f
unpackFloat (Number (Integer f)) = return $ fromInteger f
unpackFloat (List [f]) = unpackFloat f
unpackFloat notFloat = throwError $ TypeMismatch "float" notFloat

The initial work of separating integers and floats into the LispNum abstraction, and the code I said would be handy shortly, are going to be really handy here. There's relatively no change in numericBinop except for the type signature. integralBinop and floatBinop are just specific versions of the same function. I'm sure there's a nice Haskelly way of doing this with less repetition, and I welcome such corrections.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
numericBinop :: (LispNum -> LispNum -> LispNum) -> [LispVal] -> ThrowsError LispVal
numericBinop op singleVal@[_] = throwError $ NumArgs 2 singleVal
numericBinop op params = mapM unpackNum params >>= return . Number . foldl1 op

integralBinop :: (LispInt -> LispInt -> LispInt) -> [LispVal] -> ThrowsError LispVal
integralBinop op singleVal@[_] = throwError $ NumArgs 2 singleVal
integralBinop op params = mapM unpackInt params >>= return . Number . Integer . foldl1 op

floatBinop :: (LispFloat -> LispFloat -> LispFloat) -> [LispVal] -> ThrowsError LispVal
floatBinop op singleVal@[_] = throwError $ NumArgs 2 singleVal
floatBinop op params = mapM unpackFloat params >>= return . Number . Float . foldl1 op

subtractOp :: [LispVal] -> ThrowsError LispVal
subtractOp num@[_] = unpackNum (head num) >>= return . Number . negate
subtractOp params = numericBinop (-) params

numBoolBinop :: (LispNum -> LispNum -> Bool) -> [LispVal] -> ThrowsError LispVal
numBoolBinop op params = boolBinop unpackNum op params

That was a bit of work but now ElSchemo supports floating point numbers, and if you're following along then your Scheme might too if I haven't missed any important details!

Next time I'll go over some of the special forms I have added, including short-circuiting and and or forms and the full repetoire of let, let*, and letrec. Stay tuned!

Emacs for TextMate junkies

Update #1: What I first posted will take out your < key by mistake (it's available via C-q <), it has since been revised to Do The Right Thing.

Update #2: Thanks to an anonymouse[sic] commenter this code is a little cleaner.

Update #3: I should read the Emacs manual sometime, especially since I have it in dead-tree form. Check out skeleton pairs in the Emacs manual.

Despite my current infatuation with Emacs there are many reasons I started using TextMate, especially little time-savers that are very addictive. I'll talk about one of those features tonight. When you have text selected in TextMate and you hit say the ' (single quote) then TextMate will surround the selected text with single quotes. The same goes for double quotes, parentheses, brackets, and braces. This little trick is one of my favourites so I had to come up with something similar in Emacs. It was easy since a mailing list post has a solution for surrounding the current region with tags, which served as a great starting point.

1
2
3
4
5
6
7
(defun surround-region-with-tag (tag-name beg end)
      (interactive "sTag name: \nr")
      (save-excursion
        (goto-char beg)
        (insert "<" tag-name ">")
        (goto-char (+ end 2 (length tag-name)))
        (insert "</" tag-name ">")))

With a little modification I now have the following in my ~/.emacs file:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
;; help out a TextMate junkie

(defun wrap-region (left right beg end)
  "Wrap the region in arbitrary text, LEFT goes to the left and RIGHT goes to the right."
  (interactive)
  (save-excursion
    (goto-char beg)
    (insert left)
    (goto-char (+ end (length left)))
    (insert right)))

(defmacro wrap-region-with-function (left right)
  "Returns a function which, when called, will interactively `wrap-region-or-insert' using LEFT and RIGHT."
  `(lambda () (interactive)
     (wrap-region-or-insert ,left ,right)))

(defun wrap-region-with-tag-or-insert ()
  (interactive)
  (if (and mark-active transient-mark-mode)
      (call-interactively 'wrap-region-with-tag)
    (insert "<")))

(defun wrap-region-with-tag (tag beg end)
  "Wrap the region in the given HTML/XML tag using `wrap-region'. If any
attributes are specified then they are only included in the opening tag."
  (interactive "*sTag (including attributes): \nr")
  (let* ((elems    (split-string tag " "))
         (tag-name (car elems))
         (right    (concat "</" tag-name ">")))
    (if (= 1 (length elems))
        (wrap-region (concat "<" tag-name ">") right beg end)
      (wrap-region (concat "<" tag ">") right beg end))))

(defun wrap-region-or-insert (left right)
  "Wrap the region with `wrap-region' if an active region is marked, otherwise insert LEFT at point."
  (interactive)
  (if (and mark-active transient-mark-mode)
      (wrap-region left right (region-beginning) (region-end))
    (insert left)))

(global-set-key "'"  (wrap-region-with-function "'" "'"))
(global-set-key "\"" (wrap-region-with-function "\"" "\""))
(global-set-key "`"  (wrap-region-with-function "`" "`"))
(global-set-key "("  (wrap-region-with-function "(" ")"))
(global-set-key "["  (wrap-region-with-function "[" "]"))
(global-set-key "{"  (wrap-region-with-function "{" "}"))
(global-set-key "<"  'wrap-region-with-tag-or-insert) ;; I opted not to have a wrap-with-angle-brackets

Download wrap-region.el

That more or less sums up why I like Emacs so much. I wanted that functionality so I implemented it (barely! It was basically done for me), debugged it by immediately evaluating sexps and then trying it out, and then once it worked I reloaded my config and used the wanted feature. That's just awesome, and shows one strength of open source.

Embrace the database

If you drink the Rails koolaid you may have read the notorious single layer of cleverness post by DHH. [5th post on the archive page] In a nutshell he states that it's better to have a single point of cleverness when it comes to business logic. The reasons for this include staying agile, staying in Ruby all the time, and being able to switch the back-end DB at any time. Put the logic in ActiveRecord and use the DB as a dumb data store, that is the Rails way. It's simple. It works. You don't need to be a DBA to be a Rails developer.

Stephen

created a Rails plugin called dependent-raise which imitates a foreign key constraint inside of Rails. I want to try this out because I believe that data integrity is fairly important, but it's really starting to make me think about this single point of cleverness idea.

Are we not reinventing the wheel by employing methods such as this in our code? Capable DBs already do this sort of thing for us. I don't necessarily think it's bad to implement this sort of thing, but I think it's a symptom of NIH syndrome. Instead of reinventing this kind of thing why don't we embrace the DB as a semi-intelligent data store? The work has been done all we have to do is exploit it via Rails.

There are a few reasons that the Rails folks choose not to do so but perhaps some of them could be worked around. Adapting your solution as you progress and realise that things aren't exactly as you thought they were... I believe the word for that sort of thing is agility.

Database agnosticism

From SQLite to Oracle, just configure the connection, migrate, and run your app on any database. One of the biggest Rails myths that is backed by the Rails team themselves. It takes a fair amount of work to ensure that any significant app is fully agnostic. Sure you can develop on SQLite and deploy on MySQL without much trouble but there are significant diffirences between RDBMSs that will manifest themselves if you create an app that's more than a toy. Oh, you used finder_sql? Sorry but chances are your app is no longer DB agnostic. FAIL.

Solution: Drop the lie. Tell people the truth. Theoretically, theory and practice are the same; in practice they are not. Be honest that it's possible to be DB-agnostic but can be a challenge. Under no circumstances should we shun something useful in the name of claiming to be DB-agnostic.

Staying agile

If we start making use of FK constraints then we'll have to make changes to both our DB and our code. This makes change more time-consuming and error-prone which means change is less likely to happen. This goes against the grain of an agile methodology. Or does it?

Solution: Rails should use the features of the DB to keep data intact and fall back on an AR-only solution only if the DB doesn't support the operation. There doesn't need to be any duplication in logic rules either. If Rails could recognise a FK constraint that cascades on delete it could set up the has_many :foos, :dependent => :destroy relation for us. In fact I only see our code becoming DRYer (maybe even too DRY[1]).

Staying in Ruby

Using the DB from within Ruby is a solved problem. I don't see why this couldn't be extended to handle more of the DB as well. Use Ruby, but use it intelligently by embracing outside tools to get the job done.

Many relationships could be derived from constraints as people have pointed out before. There are benefits to using the features of a decent RDBMS, and in some cases I think that we might be losing by not making use of them. I am not saying we should move everything to the DB, I am saying that we should exploit the implemented and debugged capabilities of our RDBMSs the best we can while practicing the agile methods we know and love, all from within Ruby.

[1] I make liberal use of annotate_models as it is.

Reinventing the wheel

Emacs is very impressive. I only felt lost and unproductive for minutes and now it seems natural to use and get around in. I've got ElSchemo set as the default scheme, and running inferior processes interactively is an absolute dream. My scheme doesn't have readline support (which bothers me to the point where I've thought about adding it just so I can use the thing) but when running it under Emacs there's absoutely no need for anything like that since I have the power of my editor when interacting with any program.

There has been a considerable amount of work done to aide in Rails development which makes Emacs especially comfortable for me. I now know why people have Emacs windows maximized on their screens. Because of its age Emacs is a handy window manager that basically eliminates the need for anything like GNU screen or a window manager such as Rat poison (which is great if you like screen), just maximize that Emacs "frame" or open one for each display and get to it. If you need a shell you just split the window and run your shell, when you're done you can easily switch back to your editing and your shell will wait in the background until you need it again. With rails-mode on I can run script/console (or switch back to it) with C-c C-c s c. My zsh alias for script/console is sc and I have other similarly succint ones for other stuff, so I took right to the shortcuts for all the handy things that I no longer have to switch applications to do:

The Rails integration is simply stunning and I could go on all day about the mature indentation support, the Speedbar and what not, but I won't. I'm fairly sure that Emacs has taken the place of TextMate as my weapon of choice now, on all platforms. And after only 2 days!

Anyway, the point of all this was to mention the one thing that's missing: support for intelligent snippets which insert text at more than one point in the document (well, they appear to do so). I don't have any E-Lisp-fu to break out and solve the deficiency but if it ever bugs me enough I might try implementing it for Emacs one day. If they were useful to me outside of writing migrations I might have more incentive to do so, but I guess they aren't useful in normal editing situations (maybe I just haven't recognised the need).

Back on Gentoo, trying new things

I started using my Gentoo box for development again and there are a few things about Linux I didn't realize I had been missing.

Shell completion is awesome out of the box

zsh has an impressive completion system but I just don't feel the urge to ever customize it extensively. I just use the basic completion stuff on OS X because it's easy. On Gentoo I have rake tasks and all sorts of other crap completed for me by including a few lines in my .zshrc (iirc a script does this automatically anyway). Generally Linux distros try to knit everything together nicely so you never even think about things like whether or not a package will have readline support, and default configs will be tweaked and enhanced beyond the official zsh package.

Linux is stable. Really stable.

While people bash Microsoft daily for tying the GUI layer to the kernel, Apple seems to get away with it scot-free. I don't know if it's caused by my external display hooked up to the dock, or the Prolific Firewire chip in my external disk enclosure but something causes the mysterious "music plays until the end of the song, mouse can be moved, but nothing works" bug now and then and all I can do is a hard reset.

On Linux I currently use Fluxbox so everything is rock solid and fast (except Firefox! ;-), but in the extremely rare event that shit does hit the fan usually only a single app will crash, though sometimes X (and hence many others) go with it. A sudo /etc/init.d/gdm restart fixes that. The only times I've had to hard reset Linux was because of a random bug (strangely similar to my MacBook bug) with Nvidia's driver with dual head setups. All this is pretty moot since Linux is generally just stable.

Those are 2 relatively small things but the added comfort they provide is very nice.

In the spirit of switching things up I'm going to forgo my usual routine of using gvim on Linux and try out emacs. I've been frustrated with vim's lack of a decent file browser and I've never much liked the tree plugin. Vim is a fantastic editor when it comes to navigating, slicing, and dicing text. After that it sort of falls flat though. After getting hooked on TextMate I have come to love integration with all sorts of external apps such as Subversion, rake, and the shell because it makes my work easier. Emacs seems to embrace that sort of philosophy and I'm more impressed with the efforts to integrate Rails development into Emacs than vim. I'm typing this post using the Textile mode for Emacs and the markup is rendered giving me a live preview of my post. It's not WYSIWYG like Typo's preview but it's still pretty damn cool. I think can get used to emacs.

I'm just waiting for a bunch of crap to compile – because I use Gentoo – and soon I'll have a Gtk-enabled Emacs to work in. If I can paste to and from Firefox then I'll be happy. I'll have to open this in vim or gedit to paste it into Firefox, funny!

I'm also going to try replacing a couple of desktop apps with web alternatives. I'm starting with 2 no-brainers: mail and feeds with Gmail and Google Reader. I never got into the Gmail craze and never really even used Gmail very much. After looking at the shortcuts I think I can get used to it. Seeing j/k for up/down is always nice. Thunderbird is ok but there isn't a mail client on Linux that I really like, except mutt. That played a part in my Gmail choice. I hadn't used G-Reader before either and it seems alright, but it'll be hard to beat NetNewsWire.

Begging the question

I'm currently reading SICP since it's highly recommended by many people, available for free, and interesting. The fact that I have a little Scheme interpreter to play with makes it much more fun since I can add missing functionality to it as I progress through the book, thereby learning more Haskell in the process. Yay!

Anyway I was very pleased to see the only correct usage of the phrase "begs the question" I have seen in a while. It's a pet peeve of mine, but I have submitted myself to the fact that the phrase is so oft used to mean "begs for the following question to be asked..." that it may as well be re-defined. In its correct usage the sentence seems to hang there if you try to apply the commonly mistaken meaning to it. That's all very hazy so here's the usage in SICP (emphasis my own):

As a case in point, consider the problem of computing square roots. We can define the square-root function as √x = the y such that y ≥ 0 and y² = x This describes a perfectly legitimate mathematical function. We could use it to recognize whether one number is the square root of another, or to derive facts about square roots in general. On the other hand, the definition does not describe a procedure. Indeed, it tells us almost nothing about how to actually find the square root of a given number. It will not help matters to rephrase this definition in pseudo-Lisp:
(define (sqrt x)
  (the y (and (= y 0)
              (= (square y) x))))
This only begs the question.

Begging the question is to assume what one is trying to prove (or here, define) and use that as the basis for a conclusion. Read the Wikipedia article for a better definition and some nice examples.

test/spec on rails declared awesome, just one catch

This last week I've been getting to know test/spec via err's test/spec on rails plugin. I have to say that I really dig this method of testing my code and I look forward to trying out some actual BDD in the future.

I did hit a little snag with functional testing though. The method of declaring which controller to use takes the form:

use_controller :foo

and can be placed in the setup method, like so:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15 
# in test/functional/sessions_controller_test.rb

context "A guest" do
  fixtures :users

  setup do
    use_controller :sessions
  end

  specify "can login" do
    post :create, :username => 'sjs', :password => 'blah'
    response.should.redirect_to user_url(users(:sjs))
    ...
  end
end

This is great and the test will work. But let's say that I have another controller that guests can access:

1
2
3
4
5
6
7
8
9
10
11
12
13 
# in test/functional/foo_controller_test.rb

context "A guest" do
  setup do
    use_controller :foo
  end

  specify "can do foo stuff" do
    get :fooriffic
    status.should.be :success
    ...
  end
end

This test will pass on its own as well, which is what really tripped me up. When I ran my tests individually as I wrote them, they passed. When I ran rake test:functionals this morning and saw over a dozen failures and errors I was pretty alarmed. Then I looked at the errors and was thoroughly confused. Of course the action fooriffic can't be found in SessionsController, it lives in FooController and that's the controller I said to use! What gives?!

The problem is that test/spec only creates one context with a specific name, and re-uses that context on subsequent tests using the same context name. The various setup methods are all added to a list and each one is executed, not just the one in the same context block as the specs. I can see how that's useful, but for me right now it's just a hinderance as I'd have to uniquely name each context. "Another guest" just looks strange in a file by itself, and I want my tests to work with my brain not against it.

My solution was to just create a new context each time and re-use nothing. Only 2 lines in test/spec need to be changed to achieve this, but I'm not sure if what I'm doing is a bad idea. My tests pass and right now that's basically all I care about though.

More Scheming with Haskell

It's been a little while since I wrote about Haskell and the Scheme interpreter I've been using to learn and play with both Haskell and Scheme. I finished the tutorial and got myself a working Scheme interpreter and indeed it has been fun to use it for trying out little things now and then. (Normally I would use Emacs or Dr. Scheme for that sort of thing.) There certainly are interesting things to try floating around da intranet. And also things to read and learn from, such as misp (via Moonbase).

I'm going to describe two new features of my Scheme in this post. The second one is more interesting and was more fun to implement (cond).

Pasing Scheme integers

Last time I left off at parsing R5RS compliant numbers, which is exercise 3.3.4 if you're following along the tutorial. Only integers in binary, octal, decimal, and hexadecimal are parsed right now. The syntaxes for those are #b101010, #o52, 42 (or #d42), and #x2a, respectively. To parse these we use the readOct, readDec, readHex, and readInt functions provided by the Numeric module, and import them thusly:

import Numeric (readOct, readDec, readHex, readInt)

In order to parse binary digits we need to write a few short functions to help us out. For some reason I couldn't find binDigit, isBinDigit and readBin in their respective modules but luckily they're trivial to implement. The first two are self-explanatory, as is the third if you look at the implementation of its relatives for larger bases. In a nutshell readBin says to: "read an integer in base 2, validating digits with isBinDigit."

-- parse a binary digit, analagous to decDigit, octDigit, hexDigit
binDigit :: Parser Char
binDigit = oneOf "01"

-- analogous to isDigit, isOctdigit, isHexDigit
isBinDigit :: Char - Bool
isBinDigit c = (c == '0' || c == '1')

-- analogous to readDec, readOct, readHex
readBin :: (Integral a) = ReadS a
readBin = readInt 2 isBinDigit digitToInt

The next step is to augment parseNumber so that it can handle R5RS numbers in addition to regular decimal numbers. To refresh, the tutorial's parseNumber function looks like this:

parseNumber :: Parser LispVal parseNumber = liftM (Number . read) $ many1 digit

Three more lines in this function will give us a decent starting point:

parseNumber = do char '#' base <- oneOf "bdox" parseDigits base Translation: First look for an R5RS style base, and if found call parseDigits with the given base to do the dirty work. If that fails then fall back to parsing a boring old string of decimal digits. That brings us to actually parsing the numbers. parseDigits is simple, but there might be a more Haskell-y way of doing this.

-- Parse a string of digits in the given base.
parseDigits :: Char - Parser LispVal
parseDigits base = many1 d >>= return
    where d = case base of
                'b' -> binDigit
                'd' -> digit
                'o' -> octDigit
                'x' -> hexDigit
The trickiest part of all this was figuring out how to use the various readFoo functions properly. They return a list of pairs so head grabs the first pair and fst grabs the first element of the pair. Once I had that straight it was smooth sailing. Having done this, parsing R5RS characters (#\a, #\Z, #\?, ...) is a breeze so I won't bore you with that. ### The cond function ### It still takes me some time to knit together meaningful Haskell statements. Tonight I spent said time cobbling together an implementation of cond as a new special form. Have a look at the code. The explanation follows.
1
2
3
4
5
6
7
8
9 
eval env (List (Atom "cond" : List (Atom "else" : exprs) : [])) =
    liftM last $ mapM (eval env) exprs
eval env (List (Atom "cond" : List (pred : conseq) : rest)) = 
    do result <- eval env $ pred
       case result of
         Bool False -> case rest of
                         [] -> return $ List []
                         _ -> eval env $ List (Atom "cond" : rest)
         _ -> liftM last $ mapM (eval env) conseq
* __Lines 1-2:__ Handle else clauses by evaluating the given expression(s), returning the last result. It must come first or it's overlapped by the next pattern. * __Line 3:__ Evaluate a cond by splitting the first condition into predicate and consequence, tuck the remaining conditions into rest for later. * __Line 4:__ Evaluate pred * __Line 5:__ and if the result is: * __Line 6:__ #f then look at the rest of the conditions. * __Line 7:__ If there are no more conditions return the empty list. * __Line 8:__ Otherwise call ourselves recursively with the remaining conditions. * __Line 9:__ Anything other than #f is considered true and causes conseq to be evaluated and returned. Like else, conseq can be a sequence of expressions. So far my Scheme weighs in at 621 lines, 200 more than the tutorial's final code listing. Hopefully I'll keep adding things on my TODO list and it will grow a little bit more. Now that I have cond it will be more fun to expand my stdlib.scm as well.

so long typo (and thanks for all the timeouts)

Well for just over a year Typo ran the show. I thought I had worked out most of the kinks with Typo and Dreamhost but the latest problem I ran into was pretty major. I couldn't post new articles. If the stars aligned perfectly and I sacrificed baby animals and virgins, every now and then I could get it to work. Ok, all I really had to do was refresh several dozen times, waiting 1 minute for it to timeout every time, but it sucked nonetheless.

Recently I had looked at converting Typo to Mephisto and it seemed pretty painless. I installed Mephisto and followed whatever instructions I found via Google and it all just worked, with one caveat. The Typo converter for Mephisto only supports Typo's schema version 56, while my Typo schema was at version 61. Rather than migrate backwards I brought Mephisto's Typo converter up to date instead. If you're interested, download the patch. The patch is relative to vendor/plugins, so patch accordingly.

After running that code snippet to fix my tags, I decided to completely ditch categories in favour of tags. I tagged each new Mephisto article with a tag for each Typo category it had previously belonged to. I fired up RAILS_ENV=production script/console and typed something similar to the following:

1
2
3
4
5
6
7 
require 'converters/base'
require 'converters/typo'
articles = Typo::Article.find(:all).map {|a| [a, Article.find_by_permalink(a.permalink)] }
articles.each do |ta, ma|
  next if ma.nil?
  ma.tags << Tag.find_or_create(ta.categories.map(&:name))
end

When I say something similar I mean exactly that. I just typed that from memory so it may not work, or even be syntactically correct. If any permalinks changed then you'll have to manually add new tags corresponding to old Typo categories. The only case where this bit me was when I had edited the title of an article, in which case the new Mephisto permalink matched the new title while the Typo permalink matched the initial title, whatever it was.

I really dig Mephisto so far. It's snappier than Typo and the admin interface is slick. I followed the herd and went with the scribbish theme. Perhaps I'll get around to customizing it sometime, but who knows maybe I'll like a white background for a change.

301 moved permanently

Last weekend I moved out of the apartment I lived in for the last 3 1/2 years. Moving was a cinch thanks to a friend's garage, conveniently placed smack between my old place and the new one. Google maps tells me that I moved just under 3.4 km, which is 2.1 mi for the metric impaired, so it wasn't much of a move at all! My roommate and I live in the basement of a house split into 3 apartments. Our upstairs neighbours are friendly and seem pretty cool, except one lady upstairs seems a bit strange. It's a great place though and in the winter the wood stove fireplace is going to be awesome.