Today’s Programming Praxis problem is an easy one.  We’re supposed to give the prices of four items, that both sum up and multiply to $7.11. Let’s get started.

While we could just do a brute force test on all possible combinations, this would take rather long. So in order to speed things up we only check numbers that are a proper divisor of $7.11.

divs :: [Int]
divs = [x | x <- [1..711], mod (711 * 10^6) x == 0]

Once we have the divisors, solving the problem becomes a fairly trivial list comprehension (the <= bits are another optimization to eliminate some identical combinations).

main :: IO ()
main = print [(a,b,c,d) | a <- divs,         b <- divs, b <= a,
                          c <- divs, c <= b, d <- divs, d <= c,
                          a + b + c + d == 711,
                          a * b * c * d == 711 * 10^6]

If we run this, we find there is only one combination that satisfies both requirements.

Just a quick update now. I’ve just released a brand new tool called package-vt. It should be used for detecting changes in packages that should cause a version bump.

You can read more on Haskell Cafe.
Page on Hackage.
Git repo.

Stay tuned for more info!

1. Sprawdzony
   Haskell narodził się w 1987 roku, ponad 20 lat na rynku.
2. Popularny
   Język Haskell wypada dzisiaj znać. Wszyscy dzisiaj o nim mówią i piszą.
3. Dziecinnie łatwy w instalacji
   dzięki Haskell Platform. Zobacz chociażby niedawny wpis.
4. Tysiące bibliotek
   Właściwie jeden tysiąc (na razie), ale za to jak łatwo dostępne! Wszystko jest na Hackage, dziecinnie proste w instalacji przy użyciu Cabal.
5. Platformy
   systemy Windows, Unix, MacOSX, Linux. Architektury PowerPC, x86, ARM. Wersje 32 i 64bit.
6. Otwarty
   źródła praktycznie każdego narzędzia dostępne na otwartych licencjach, wszystko oparte o publiczne specyfikacje. Gratis!
7. Skrzynka z narzędziami
   zawiera wszystko, co potrzebne do wygodnej i wydajnej pracy, takich jako kompilatory, profilery, debuggery, dokumentacja, testy. W skrzynce jest też kilka nowiutkich zabawek!
8. Równoległy i współbieżny
   programowanie równoległe i współbieżne jeszcze nigdy nie dawało takich wyników.
9. Dostajesz co zamówiłeś
   Statyczne typowanie zapewnia bezpieczeństwo podczas używania zmiennych. Z żadnego kontenera nie wyciągniesz już królika!
10. Oszczędź sobie niespodzianek
    dzięki algebraicznym typom danych oraz dopasowywaniu wzorca nie zapomnisz już o żadnym szczególnym przypadku.
11. Typ z klasą
    klasy typów to zestawy metod (interfejsy). Haskell jest elastyczny i pozwala implementować interfejsy od definiowanych obiektów.
12. Szablony wykonane prawidłowo
    Funkcje oraz typy mogą zostać zdefiniowane dla danych uogólnionych dzięki polimorfizmowi parametrycznemu.
13. Nie daj się zaskoczyć
    Czyste funkcje dotrzymują słowa: żadnych efektów ubocznych!
14. Programowalny średnik
    Monady potrafią więcej, niż możesz sobie wyobrazić.
15. Lenistwo
    a właściwie leniwość. Operuj na nieskończonych strukturach danych istniejących potencjalnie tylko w Twojej wyobraźni!
16. Inteligentny kompilator
    nie Ty informujesz kompilator o typie danych, o typie danych kompilator informuje Ciebie.
17. Funkcje wyższego rzędu
    korzystaj z narzędzi z najwyższej półki dostępnych w każdej chwili.
18. Żadnych wskaźników
    oraz oczywiście automatyczne zarządzanie pamięcią. Haskell dba o Twoje zdrowie psychiczne.
19. Towarzyski
    Haskell tworzy zdrowy ekosystem z kodem napisanym w C, Objective C, COM, SOAP, AppleAcript, Lua, i innymi.
20. Nie jesteś sam
    społeczność wokół języka Haskell jest ogromna i ciągle rośnie! Jest planet, jest #haskell, ze dwie listy mailingowe haskell-cafe i haskell-beginners.
21. Zwięzły i elegancki
    Haskell po prostu da się kochać.

Over the last couple of days, I have implemented a small benchmark suite which tries to measure the performance of various Haskell array libraries, with particular emphasis on finding out how well they are able to fuse things. It is now on Hackage under the very creative and imaginative name NoSlow (Haskell seems to have gained a tradition of naming benchmark suites nosomething). What it does is compile and run a set of micro-benchmarks using these libraries:

• standard lists
• primitive arrays from the DPH project (package dph-prim-seq)
• uvector (a fork of the above)
• vector (primitive, storable and boxed arrays)
• storablevector

The actual benchmarking is done by Brian O’Sullivan’s wonderful criterion.

NoSlow is a very young project so the output isn’t particularly pretty but it does the job. It is also not very thoroughly tested and only includes a very restricted set of benchmarks so saying “library x is better than library y because it produces better numbers in NoSlow” would be completely and utterly wrong. However, it is quite useful for identifying cases where taking a closer look at the code generated for a particular loop might be a good idea. It already helped me spot one tricky performance regression in the standard list library.

Here is an example of the data it produces.

Benchmarks

At the moment, NoSlow only benchmarks a bunch of very small and fairly random loop kernels as I was more concerned with getting the infrastructure in place. Here is an example (called $a+$b in the table):

dotp as bs = sum (zipWith (*) as bs)

When it is built, NoSlow compiles several different versions of this loop. For instance, for the storablevector backend it will generate these two functions:

dotp :: (Storable a, Num a) => StorableVector a -> StorableVector a -> a
dotp :: StorableVector Double -> StorableVector Double -> Double

The first one is overloaded on the element type whereas the second one is specialised to Double. NoSlow does this for all its backends and then runs all generated versions of the benchmark with the same test data. With more testing and more benchmarks, this will give us a rough estimate of the relative performance of the different array libraries. It also shows how much faster specialised loops are compared to their polymorphic versions

Here is the output of a full run. *Double and Double are overloaded and specialised loops, respectively. At the moment, NoSlow only does Double benchmarks but adding more types is easy.

NoSlow can also be used to see how well different GHC versions optimise array loops. Here is a comparison of the current HEAD to GHC 6.10.4 (2 means 6.13 is 2x slower, 0.5 means it is 2x faster).

Usage

The current interface is rather minimalistic. After building NoSlow, you get two binaries: noslow and noslow-table. The first one runs the actual benchmarks and produces a log file:

noslow -u log

The log can then be fed to noslow-table to generate HTML tables:

noslow-table log > table.html

We can also restrict the output to a particular data type:

noslow-table log --type=Double > table.html

or compare two logs:

noslow-table --diff log1 log2 > table.html

In this case, the table will contain ratios of corresponding values from the two logs, just like in the table above.

Compiling

NoSlow should work out of the box with GHC 6.10. I haven’t tried it with 6.12 because I didn’t have time to install the release candidate and the required packages. Getting it to build with the HEAD (which is what I’m interested in) is a rather annoying process, though, because uvector is missing a DPH patch which would make it work with the new IO system. Fortunately, I could simply transplant some code from the DPH library (the module is dph-base/Data/Array/Parallel/Data/Array/Parallel/Arr/BUArr.hs) and everything worked.

Also, storablevector depends on QuickCheck 1 which doesn’t seem to compile with the HEAD. I just removed all references to QuickCheck from the code but it might be easier to simply not build the storablevector backend (there is a flag for that).

How it works

Benchmarking itself is rather straighforward – all the exciting bits are in criterion. The heart of NoSlow is the specialiser – a Template Haskell function that takes a bunch of abstract loop kernels and specialises them for a particular backend and data type. Here is how it works. The kernels themselves are implemented in a TH quote:

kernels = [d| ...
    dotp :: (Num a, I.Vector v a) => Ty (v a) -> v a -> v a -> a
    dotp _ as bs = named "sum($a*$b)" $ I.sum (I.zipWith (*) as bs)
    ... |]

They refer to functions from module I (short for NoName.Backend.Interface) which are just stubs and do not provide any real functionality. The specialiser traverses the ASTs of the kernels (which it has access to since they are quoted) and replaces references to those stubs with calls to functions from the backend that it is specialising for. For instance, it replaces I.sum by NoSlow.Backend.List.sum (which is just a reexport of the Prelude function) when specialising for lists. It also adjusts signatures and looks for tags like named in the example above which defines the kernel’s name in the HTML output.

This scheme has one big advantage: it allows backends to mark some kernels as unsupported. An example is storablevector which does not support arrays of pairs. The corresponding backend defines zip like this:

zip :: Undefined
zip = Undefined

When replacing I.zip with NoSlow.Backend.StorableVector.zip, the specialiser reifies the latter, notices that its type is Unsupported and omits the kernel that contains the call to zip altogether.

Wpis jest tłumaczeniem Why learning Haskell/Python makes you a worse programmer by Luke Palmer z 2006 roku. Czy dziś sytuacja wygląda tak samo? Oceńcie sami:

Stwierdziłem, że w przeciwieństwie do tego co można czasem przeczytać tu i ówdzie, nauczenie się Pythona lub Haskella nie podniosło jakości mojego kodu w innych językach. W szczególności Haskell, tak inny od języków imperatywnych, podobno miał wznieść moje programowanie na wyższe poziomy świadomości, nawet jeśli nie będę używał innych narzędzi. Moje aktualne doświadczenia nie popierają tej tezy. Oto dlaczego:

1. Obniżenie motywacji.

   Zacząłem myśleć w Pythonie, a nawet w Haskellu, w którym programowałem bardzo mało. Cały czas mam ochotę używać idiomów z tych języków, bez przerwy zauważam, ile mniej kodu byłoby potrzebne. Oba, wprawdzie różne, jednak są znacznie potężniejsze niż język C# używany przeze mnie obecnie w pracy. Zauważam bardzo często, że pewnego fragmentu kodu mogłyby być 2 lub 3 (a wcale nie tak rzadko 10 czy 20) razy krótsze.

   Dalej, przez moje doświadczenia z Haskellem teraz w kodzie imperatywnym wszędzie widzę potencjalne błędy. Wcześniej byłem w pełni świadomy problemów, które niesie za sobą programowanie stanowe i zagrożeń związanych z efektami ubocznymi. Spędziłem niezliczone godziny rozwiązując tabuny błędów tego typu. Ale ponieważ wtedy nie znałem żadnej alternatywy, więc po prostu z tym żyłem. Od kiedy znam inny sposób zapobiegania tego typu zagrożeniom, ciężko jest mi być zadowolonym z mojego kodu. Cały czas mam świadomość, że zastawiam imperatywne pułapki, w które najprawdopodobniej kiedyś wpadną niewinni ludzie.

   Także kod w C# wydaje mi się być wyjątkowo brzydki w porównaniu z Pythonem czy Haskellem. Wizualne używanie takiej ilości obowiązkowych nawiasów klamrowych wszędzie (OK, nie obowiązkowych, ale zwykle wymaganych standardami kodowania) powoduje, że kod zawiera wiele niepotrzebnego szumu i pustego miejsca. W połączeniu z ogólną wylewnością bibliotek oraz deklaracji typów często zdarza się, że cała strona kodu C# nie robi praktycznie nic. Mam w tej chwili na myśli też piękno w matematycznym tego słowa znaczeniu. C# to gliniana chatka stojąca w cieniu przepięknej wieży Haskella.

   Efektem moich przemyśleń jest poczucie zdołowania i demoralizacji. Czuję się jak ludzki kompilator, tłumaczący Haskella czy Pythona w mojej głowie na język położony cały poziom niżej.

2. Używanie funkcyjnego stylu programowania zaciemnia kod w innych językach.

   C# od pewnego czasu nabiera własności pomocnych w programowaniu funkcyjnym. Któregoś dnia spróbowałem użyć ich do funkcyjnego rozwiązania prostego problemu. Mam listę obiektów typu Foo, każdy ma metodę Description() zwracającą napis. Zadanie polega na połączeniu wszystkich niepustych opisów wstawiając pomiędzy nie znaki końca linii.

   Chciałem napisać odpowiednik Pythonowego kodu:

   "\n".join(foo.description() for foo in mylist
                            if foo.description() != "")
   

   Albo takiego w Haskellu:

   concat $ List.intersperse "\n" $ filter (/= "") $ map description mylist
   

   Używając generyków z C# 2.0 najlepsze do czego doszedłem to:

   string.Join("\n", mylist.ConvertAll<string>(
               delegate(Foo foo)
               {
                       return foo.Description();
               }).FindAll(
               delegate(string x)
               {
                       return x != "";
               }).ToArray());
   

   Strach pomyśleć co by było, gdybym wyszedł od innej struktury danych: wersja C# byłaby pewnie jeszcze gorsza. A C# posiada przecież setki różnych klas kontenerów z niekompatybilnymi interfejsami. Trzeba też zauważyć, że jeśli piszę jakąś metodę, która przyjmuje ‘delegatów’ (najbliższy odpowiednik pełnoprawnych funkcji) musisz dla nich napisać nagłówek typu osobno jeśli takowy jeszcze nie istnieje (lub nie wiesz gdzie go znaleźć), co dodatkowo powoduje rozrost kodu pisanego w stylu funkcyjnym.

   Wersja C# ma kilka poważnych wad. Wcale nie jest krótsza od kodu imperatywnego. Porównajmy ze zwykłą pętlą:

   string retval = "";
   foreach (Foo foo in mylist)
   {
       string desc = foo.description();
       if (desc != "")
       {
               if (retval != "")
                  retval += "\n";
               retval += desc;
       }
   }
   

   Nie ma tutaj niespodzianek.

   Po drugie, wersję funkcyjną pisałem dłużej. Musiałem trochę po eksperymentować ile potrzeba dodatkowej informacji o typach do zadowolenia kompilatora. Okazało się, że bezpośrednie kastowanie dla delegata nie było potrzebne, ale za to trzeba było napisać ConvertAll<string> zamiast ConvertAll.

   W końcu, ten kod spowoduje, że mam przechlapane u kolegów. Dlaczegóż piszę tak skomplikowany kod – z takimi zaawansowanymi cudactwami jak anonimowi delegaci – skoro zwykła pętla wystarczy? Zostawiłem wersję funkcyjną, ale poczułem się tak nieswojo, że dodałem notkę wyjaśniającą powyższy fragment.

   Prawdą jest, że idiomy funkcyjne źle działają w językach, które nie mają dla nich wsparcia składniowego. Java, z tego co wiem, byłaby jeszcze gorsza niż C#, który na szczęście od niedawnej wersji 2.0 posiada coraz więcej cech pozwalających na przyjemniejsze programowanie funkcyjne. Jednak ogromne części bibliotek .NET się nie zmieniły i nie korzystają z udogodnień, a nasz własny kod na pewno też nie jest lepszy.

   Można się uprzeć i dalej używać zasad programowania funkcyjnego (żadnych efektów ubocznych, funkcje zależą tylko od swoich argumentów, itp.) i czerpać z tego korzyści, nawet nie używając idiomów. W rzeczywistości jednak biblioteki i frameworki zaprojektowane dla języków imperatywnych nie działają w ten sposób. ASP.NET jest szczególnie fatalnym przykładem. Tworzę kontrolki dziedzicząc po klasie Control i nadpisuję poszczególne metody. Większość z nich nie ma argumentów i nie zwraca żadnych wartości, za to działa tylko i wyłącznie przez zmianę wewnętrznego stanu obiektów. Są wywoływane przez framework w prawdziwie delikatnym i skomplikowanym porządku (tak, koszmar do debugowania).

   W rzeczywistości stosowanie się do zasad programowania funkcyjnego prowadziłby mnie do używania wyłącznie metod statycznych (nigdy metod instancji obiektu), omijanie szerokim łukiem wszystkiego co zmienia stan (lub niesie możliwość zmiany stanu). Używałbym wszędzie kilku prostych typów danych i pilnował oddzielenia ich od algorytmów. To przeczy naukom i praktyce głównego dzisiaj nurtu programistycznego czyli programowania obiektowego. Nie mogę używać według mnie dobrych zasad pisania kodu bez odrzucenia głównego paradygmatu języka i bibliotek w jakich się poruszam. Jest to droga donikąd.

Python i Haskell zdemoralizowały mnie i zachęciły do pisania kodu, który jest dziwny, trudny do zrozumienia, a w kontekście bazy obiektowego zorientowanego kodu nie daje żadnych profitów ponad programowanie imperatywne. Nie wątpię, że ogólnie stałem się lepszym programistą dzięki tym językom, ale w obecnej sytuacji nie jestem lepszym deweloperem – moja produktywność w rzeczywistości poleciała w dół na łeb na szyję. Jak czuję się sfrustrowany napisanym przez siebie kodem w C#, piszę go po raz wtóry w Pythonie czy Haskellu, żeby udowodnić sam sobie jak dużo lepsze są te języki, co jest bezsensowne samo w sobie i demotywuje mnie jeszcze bardziej.

Morał opowieści: nie próbuj rozwijać się, jeśli nie masz wolności rozwinąć również swojego środowiska. Wiem, to raczej depresyjny wniosek. Niech mnie ktoś przytuli…

Uaktualnienie: możliwe, że powinienem bardziej otwarcie przyznać, że tytuł postu nie jest absolutnie poważny i miał na celu przykuć uwagę.

Per il corso di logica informatica qui a Granada devo sviluppare alcuni piccoli progetti pratici in Haskell.

Ne sto letteralmente uscendo matto.

Ho trovato questo free book (c’è la versione online o pdf) che sembra essere interessante, lo segnalo nel caso potesse servire a qualcuno: Wikibooks – Haskell

The All Blacks were supposed to be England’s toughest Test. After each game in this series, it was; ‘We’ll get massacred by New Zealand if we play like that.” As it happens, being the underdogs gave England an opportunity to have a go at the underperforming, but still fearsome Kiwis (though not to the same degree as plucky Scotland, who won a deserved victory over Australia).

The early sparring saw England twice go ahead, 3-0, then 6-3, before Dan Carter levelled each time.  Ugo Monye nearly did the team an even bigger favour, just failing to intercept the ball when he had come off his wing and the All Blacks had decided to run from their 22.  In all, however, it was quite a dull first half, with England holding on and Carter missing the kicks that would have allowed New Zealand the comfort to play their own game.

It was in the second half that England began to exert some pressure of their own, but the game was determined in a ten-minute period starting fifteen minutes into the second half.  First, Wilkinson’s chip into the 22 saw a whole pack of England players bearing down on New Zealand.  The All Blacks, however, were quite content to use the space run it out of their 22.  Nonu’s inside pass releasing Zac Guildford, and Wilkinson had to backtrack thirty metres to dislodge the ball from the winger.

Not long afterwards New Zealand took clean ball from a lineout and as the forwards drove into the England 22, created space on the blindside.  Although Sivivatu was marked by Banahan, he jinked and held the defender in place as Richie McCaw and Jimmy Cowan came round the scrum.  Sivivatu slipped the ball inside, for McCaw to play in Cowan.  It was a devastating display of passing, allowing New Zealand to turn a non-advantage into a decisive overlap.

England found themselves in the All Black’s half several times with options, but frequently took the wrong ones.  Wilkinson’s first option when given the ball on the 22 was to take a drop, highlighting the paucity of England’s ambition.  In response, Mils Muliaina sliced through England’s defence before feeding Conrad Smith, who was forced into touch just yards from the line.

Haskell made a few half-breaks, but it was Tom Croft (on for the injured Joe Worsely after two minutes) who ripped the ball from a New Zealand maul after Wilkinson’s teasing kick, and seemed almost certain to cross but for determined defence.  Duncan Bell picked up and dived for the blindside, but was held up short, and the forwards could not clear the ball.  The resulting scrum proved disastrous, and the put-in was reversed.

Late on, Geraghty’s chip could have found Monye but bounced short and a last minute encampment on the New Zealand line turned to farce.  As has become common, England’s attack had wanted composure and received only individualism.

It is getting easy to forget what England are good at, but the scrum and particularly the lineout were solid.  Wilkinson, Borthwick and Moody typified an almost complete defensive performance, but it is possession that seems to worry England most.  In Haskell, Croft and Hartley, they have plenty of quick forwards who love to run, but no stand-out ball carriers who will break the gain line when defences have re-grouped.  For that, they probably missed Worsley and later, Shaw, but the distribution was also inadequate.  Hodgson seems to get drawn into rucks too easily, and Wilkinson plays too deep to encourage players to run good lines.  England miss Flutey desperately.  Unfortunately, Wilkinson’s defence is just too invaluable, so the first-receiver problem is key.

In an ongoing project, I’ve needed to do a bit of Haskell type-hackery with type functions implemented with type families. One thing I’ve needed is a type-heterogeneous sort — more than a type level sort, but a function that takes a value of one product type, and produces a value of a different, sorted product type. In doing so it needs to both sort the parameter type into a (potentially) different result type, as well as sort the parameter value into a result value (which of course needs to be of the result type). This works out to be a bit more complex than a pure type level sort (such as the quicksort implemented here, using funcitonal dependencies, or the merge sort implmenented here, again using functional dependencies), as Haskell type classes have to be used to select the right value-level functions to use for each step of the sort process. It was an interesting puzzle to solve — at least for me, as type level programming isn’t my strong point! (To make the problem a bit easier, I implemented a simpler, if less efficient, sorting algorithm, but quick sort or merge sort should also work at the type/value level).

Given a type for tagged values, e.g.

    -- n is a phantom, type-level natural
    newtype Tagged n t = Tagged t

And a product type, e.g.

    data a :* b = a :* b
    infixr 6 :*

I want to define tagged values such as:

    tv0 :: Tagged N0 String
    tv0 = Tagged "hello"
    tv1 :: Tagged N1 Int
    tv1 = Tagged 2
    tv2 :: Tagged N2 Bool
    tv2 = Tagged False
    -- etc.

I want to be able to apply a function sort to an arbitrary product of these types:

    x = sort ( tv2 :* tv0 :* tv1 )
    y = sort ( tv1 :* tv2 :* tv0 )

And the result should be the sorted product, i.e. x == y && x == Tagged "hello" :* Tagged 2 :* Tagged False. Note that in the first application of sort, sort needs a type like:

    sort :: (Tagged N2 Bool :* Tagged N0 String :* Tagged N1 Int) ->
        (Tagged N0 String :* Tagged N1 Int :* Tagged N2 Bool)

and in the second, it needs:

    sort :: (Tagged N1 Int :* Tagged N2 Bool :* Tagged N0 String) ->
        (Tagged N0 String :* Tagged N1 Int :* Tagged N2 Bool)

It needs to work for arbitrarily long products of any Tagged type (with the constraint that the index n must be a type-level natural). My solution to the problem follows.

> {-# LANGUAGE EmptyDataDecls, TypeFamilies, UndecidableInstances,
>              ScopedTypeVariables, OverlappingInstances, TypeOperators,
>              FlexibleInstances, NoMonomorphismRestriction #-}
> module TSort where

I started with the usual definition for type level naturals (with some convenient aliases for a few of them):

> data Zero
> data Succ n

> type N0 = Zero
> type N1 = Succ Zero
> type N2 = Succ N1
> type N3 = Succ N2
> type N4 = Succ N3
> type N5 = Succ N4
> type N6 = Succ N5
> type N7 = Succ N6
> type N8 = Succ N7
> type N9 = Succ N8
> type N10 = Succ N9

I also use type level booleans:

> data TRUE
> data FALSE

I need one inequality operator on naturals:

> type family LessThan m n
> type instance LessThan Zero Zero = FALSE
> type instance LessThan (Succ n) Zero = FALSE
> type instance LessThan Zero (Succ n) = TRUE
> type instance LessThan (Succ m) (Succ n) = LessThan m n

I need a type level if statement:

> type family Cond c t f
> type instance Cond TRUE t f = t
> type instance Cond FALSE t f = f

I need my tagged and product types:

> newtype Tagged n a = Tagged a deriving (Show,Eq)

> data a :* b = a :* b deriving (Show,Eq)
> infixr 6 :*

The general type of my sort is going to be something like (but not exactly):

    sort :: (Sortable a) => a -> Sorted a

where Sortable is a type class and Sorted is a associated type of that type class. It didn’t work out to be quite that simple, but this is how I started thinking about the problem.

I envisioned the Sortable class as:

    class Sortable a where
        type Sorted a
        sort :: a -> Sorted a

Trying to create a simple instance of this type, for a pair of tagged values got me a bit bogged down:

    instance Sortable (Tagged m a :* Tagged n b) where
        type Sorted (Tagged m a :* Tagged n b) = ???
        sort = ???

The type of Sorted for this pair is conditional based on the value of the indices m and n, so I can write the type function like this:

    type Sorted (Tagged m a :* Tagged n b) =
        Cond (LessThan n m) -- if n < m
            (Tagged n b :* Tagged m a) -- then swap
            (Tagged m a :* Tagged n b) -- else don't

but how to write the sort function? It can’t test the type and decide whether to swap the values. The key insight for solving this problem was that I needed some additional types to represent the operations I needed. For this simple reordering of a pair, I need two operations – Swap, to swap the elements of the pair if they are out of order, and Id (identity), to leave them alone if they are already in order:

    data Swap x y = Swap x y
    data Id a = Id a

Each of these can be seen as implementing a single step in a sorting algorithm). Each will be an instance of a Sorter class:

> class Sorter a where
>     type Sorted a
>     type Unsorted a

mkSort ‘makes’ a sort function from (Unsorted a -> Sorted a) based on the type of its first argument, which is a proxy argument (its value is never examined).

>     mkSort :: a -> Unsorted a -> Sorted a

The Swap instance of Sorter just swaps the values in a pair:

> instance Sorter (Swap x y) where
>     type Sorted (Swap x y) = y :* x
>     type Unsorted (Swap x y) = x :* y
>     mkSort _ (x :* y) = y :* x

The Id instance of Sorter leaves its value alone:

> instance Sorter (Id a) where
>     type Sorted (Id a) = a
>     type Unsorted (Id a) = a
>     mkSort _ v = v

Now my Sortable class, instead of having a sort function, needs instead a function to produce a sorter value:

> class Sortable a where
>     type SorterType a
>     sorter :: a -> SorterType a

And the sort can be written in terms of functions from the two classes:

> sort v = mkSort (sorter v) v

But still, how to implement the sorter function for my pair of tagged elements?

> instance Sortable (Tagged m a :* Tagged n b) where

The type function for the SorterType is now:

>     type SorterType (Tagged m a :* Tagged n b) =
>         Cond (LessThan n m)
>             (Swap (Tagged m a) (Tagged n b))
>             (Id (Tagged m a :* Tagged n b))
>     sorter = undefined -- ???

As it turns out, the above implementation is sufficient. Since the mkSort function doesn’t examine its first argument — it’s merely a proxy — the sorter function doesn’t need to produce a value. So sorter can be left undefined — all its ‘work’ is done at compile time, in producing the right type such that the instance of ‘mkSort’ can be inferred (I have to admit, I discovered this accidentally while writing the sorting function. I left sorter undefined because I couldn’t think of how to define it, then wrote sort in terms of it, and accidentally ran it. It worked, my mind boggled, and then I figured out what what going on). Because no concrete value of either the Id or Swap types are ever needed, the actual definitions for these can be:

> data Id a
> data Swap a b

To sort something more than a pair, I need to be able to do more than just swap two types and values. A simple algorithm for sorting the product is to sort the ‘tail’ of the product, then insert the head of the product into the sorted tail (this is insertion sort — not the most efficient, but simpler than merge sort or quick sort). For this I need two more operations, a sort-then-insert operation, and an insert operation (the sort-then-insert operation sorts its ‘tail’ and then (if necessary) uses the insert operation to insert its head into the sorted tail). I need these operation types:

> data SortInsert h t
> data Insert x y

I need a new class similar to Sortable, which has a InserterType and a function to produce a InserterType from the instance type:

> class Insertable a where
>     type InserterType a
>     inserter :: a -> InserterType a

A insertable assumes that its tail is sorted. For a product of tagged values (more than a pair), the Insertable instance looks like this:

> instance Insertable (Tagged m a :* Tagged n b :* c) where

The InserterType depends on whether the head element is less than the first element of the sorted tail. If it is, then the InserterType is the identity, otherwise it is an Insert x y:

>     type InserterType (Tagged m a :* Tagged n b :* c) =
>              Cond (LessThan n m)
>                  (Insert (Tagged m a) (Tagged n b :* c))
>                  (Id (Tagged m a :* Tagged n b :* c))

As in the sorter function of a Sortable, we don’t need the inserter to do anything more than create a proxy argument:

>     inserter = undefined

Inserting two elements is the same as sorting them:

> instance Insertable (Tagged m a :* Tagged n b) where
>     type InserterType (Tagged m a :* Tagged n b) =
>         Cond (LessThan n m) (Swap (Tagged m a) (Tagged n b))
>             (Id (Tagged m a :* Tagged n b))
>     inserter = undefined

A Inserter is similar to a sorter: it takes an value of an Uninserted type and produces a value of an Inserted type:

> class Inserter a where
>     type Inserted a
>     type Uninserted a

mkInsert ‘makes’ a function (Uninserted a -> Inserted a) from the instance type. The first argument again is just a proxy, it’s value never inspected:

>     mkInsert :: a -> Uninserted a -> Inserted a

The identity instance is straightforward:

> instance Inserter (Id a) where
>     type Inserted (Id a) = a
>     type Uninserted (Id a) = a
>     mkInsert _ v = v

The Swap instance of Inserter is essentially the same as the Swap instance of Sorter:

> instance Inserter (Swap a b) where
>    type Inserted (Swap a b) = b :* a
>    type Uninserted (Swap a b) = a :* b
>    mkInsert _ (a :* b) = b :* a

The Insert instance for a longer product has a rather convoluted context:

> instance (Insertable (a :* c)
>          , Inserter (InserterType (a :* c))
>          ,(a :* c) ~ Uninserted (InserterType (a :* c))
>          ) => Inserter (Insert a (b :* c)) where

The Inserted type is the first element of the tail followed by a inserted into the tail (via sort):

>     type Inserted (Insert a (b :* c)) = b :* Inserted (InserterType (a :* c))

The uninserted type is simply the original (uninserted) product:

>     type Uninserted (Insert a (b :* c)) = a :* b :* c

And the insert function effectively swaps the first two elements of the product and inserts the (new) tail:

>     mkInsert _ (x :* y :* z) = y :* mkInsert (inserter $ x :* z) (x :* z)

The Sorter instance for a SortInsert that we need again has a convoluted context:

> instance (Sortable (b :* c)
>           ,Unsorted (SorterType (b :* c)) ~ (b :* c)
>           ,Uninserted (InserterType (a :* Sorted (SorterType (b :* c)))) ~
>                (a :* Sorted (SorterType (b :* c)))
>           ,Sorter (SorterType (b :* c))
>           ,Insertable (a :* Sorted (SorterType (b :* c)))
>           ,Inserter (InserterType (a :* Sorted (SorterType (b :* c))))
>           ) =>
>         Sorter (SortInsert a (b :* c)) where

The type of the output of the sort is the type of the output of the head of the product inserted with the sorted tail:

>     type Sorted (SortInsert a (b :* c)) =
>         Inserted (InserterType (a :* (Sorted (SorterType (b :* c)))))

The type of the input of the sort is the original (unsorted, uninserted) product:

>     type Unsorted (SortInsert a (b :* c)) = a :* b :* c

And the sort function is just the insert of the head into the tail after the tail is sorted:

>     mkSort _ (a :* b :* c) = mkInsert (inserter preinsert) preinsert
>         where preinsert = a :* sort (b :* c)

Finally, the Sortable instance for an arbitrary product is:

> instance (Sortable (b :* c), Sorter (SortInsert a (b :* c))) =>
>     Sortable (a :* b :* c) where
>     type SorterType (a :* b :* c) = SortInsert a (b :* c)
>     sorter = undefined

Given some tagged values, I can try out the sort function:

> t0 :: Tagged N0 String
> t0 = Tagged "hello"
> t1 :: Tagged N1 Bool
> t1 = Tagged True
> t2 :: Tagged N2 Int
> t2 = Tagged 5
> t3 :: Tagged N3 String
> t3 = Tagged "goodbye"

   *TSort1> sort (t2 :* t0 :* t1 :* t3)
   Tagged "hello" :* (Tagged True :* (Tagged 5 :* Tagged "goodbye"))
   *TSort1> sort (t3 :* t2 :* t1 :* t0)
   Tagged "hello" :* (Tagged True :* (Tagged 5 :* Tagged "goodbye"))
   *TSort1>

Beyond being an interesting puzzle to solve, there’s at least some use for such a function. For example, in a DSL that has operations that support named parameter association:

> rawConnect :: (Tagged N0 String :* Tagged N1 Int :* Tagged N2 String :*
>      Tagged N3 String) -> IO ()
> rawConnect (Tagged host :* Tagged port :* Tagged user :* Tagged pass) =
>     putStrLn $ "connecting to " ++ host ++ " on port " ++ show port ++
>        " with username " ++ user ++ " and password " ++ pass
>
> connect = rawConnect . sort
>
> (=:) = ($)
> host :: String -> Tagged N0 String
> host = Tagged
> port :: Int -> Tagged N1 Int
> port = Tagged
> user :: String -> Tagged N2 String
> user = Tagged
> password :: String -> Tagged N3 String
> password = Tagged

Now you can invoke the ‘connect’ operation with parameters in no particular order:

> doit = do
>    putStrLn "trying to connect!"
>    connect ( user =: "admin" :*
>              password =: "pa55w0rd" :*
>              port =: 22 :*
>              host =: "example.com" )
>    putStrLn "connected!"

… which is at least mildly cool, for certain definitions of cool.

Brought to you by BlogLiterately with generous support from pandoc, hscolour and viewers like you.

Wrote some “functions” in Function Programming (FP) the other day. Interesting, to say the least. It was for a class but it was really my first hands on experience with a functional language.

Although there is an interpreter for this language, it isn’t as developed as it could be and it definitely needs a debugger. Anyway, interesting first experience.

Now onto Haskell. Oh fun. At least there’s a huge amount of documentation and books on how to program in Haskell =) It’s always good to have resources. Will write more about it when I know what I’m doing!

Haskellは、ファイルの入出力が簡単。
ですが、モナドを使いこなさなくてはならないので、適当に書いていると、しょっちゅうエラーが出てくる。

入力はreadFile、出力はwriteFile。do記法を使う。IOの結果を、　<-　で取り出してしまえば後は簡単。

main = do
  contents <- readFile "test.txt"
  writeFile "output0.txt" $ contents                                      -- そのまま出力
  writeFile "output1.txt" $ unlines $ map ("#" ++) $ lines contents       -- 各行の先頭に # をつける
  writeFile "output2.txt" $ unlines $ map (reverse) $ lines contents      -- 各行を反転させる

• readFile :: FilePath -> IO String　　ファイルを読み込み、Stringにして返す
• writeFile :: FilePath -> String -> IO ()　　ファイルに出力

つぎは、ファイルから入力した内容によってなんらかの作業を行う。

import System.Cmd(system)
import System.Posix

main = do
  contents <- readFile "test.txt"
  mapM_ system $ lines contents                                                -- 読み込んだ内容の各行をコマンドとして実行
  (sequence_ $ take 10 $ cycle [testSleep, print ”aaa”])               -- スリーブとprintを交互に実行

testSleep = do
  sleep 1
  return ()

• system　　コマンドの実行
• sequence_　　リストの中身を順に実行。結果を無視する。
• mapM_　　sequence_ . map と同等

コマンドの実行は、systemでいいのですが、ここで、mapを使って、要素に対してsystemを使いたいとする。しかし、
map system xs
とするだけでは、IOのリストになってしまい、なにも実行されない。（というより、mainのdo記法の中に直接書くとコンパイル出来ない。）sequence_ で、「順に実行する」という関数にしておくことで、doの中に書けるようになる。

Prelude System.Cmd> :t map system ["ls", "pwd"]
map system ["ls", "pwd"] :: [IO GHC.IOBase.ExitCode]

Prelude System.Cmd> :t sequence_ $ map system ["ls", "pwd"]
sequence_ $ map system ["ls", "pwd"] :: IO ()

… yet. It’s actually quite the opposite: I’m alive but quite busy. It’s hard for me to find any time to write anything for the blog. I’ve been writing quite a lot recently, most of which you can read in this article.

To be more specific: I wrote an introductory article about basics of Haskell for a polish computer science portal. I put quite some effort in it (~25h), but I hope there are people that will benefit from it greatly.

CA assignment 3 is now out, and in class today we were looking at the stuff we needed for question 2 (which is ex. 7.1 in the textbook). It’s to manually solve the isomorphism for the two graphs below:

Petersen Graph

So I start sketching this out, and then it occurs to me that – ooh, I could easily write some code to validate it for me after I’ve worked it out.

And then it occurs to me that all I’m doing is trying permutations of “abcdefghij” (where the position in the string is the number they’re trying to replace). And if I used Haskell and the handy “permutations” method I could just code it in a brute force manner, and it would solve it for me.

So of course that’s what I did. This is a programmer thing, I think. We work out how to automate things and then we automate them. Yes, it probably took me longer to write the code than it would have to solve the thing manually. I was quite shocked that it ended up being over 60 lines (including white-space, but still… this is Haskell) although I did include my data (the edges) and methods to validate them. I think it could be done with less code, my Haskell is a little rusty.

I find programming much more satisfying than drawing the graph countless times until you get the right answer. Also, my code is purring away now generating all the valid permutations.

In case you’re interested… here are the first 20:

(‘c’,0),(‘d’,1),(‘e’,2),(‘f’,3),(‘g’,4),(‘b’,5),(‘i’,6),(‘h’,7),(‘a’,8),(‘j’,9)

(‘e’,0),(‘d’,1),(‘c’,2),(‘b’,3),(‘h’,4),(‘f’,5),(‘i’,6),(‘g’,7),(‘a’,8),(‘j’,9)

(‘d’,0),(‘e’,1),(‘f’,2),(‘a’,3),(‘i’,4),(‘c’,5),(‘h’,6),(‘g’,7),(‘b’,8),(‘j’,9)

(‘f’,0),(‘e’,1),(‘d’,2),(‘c’,3),(‘g’,4),(‘a’,5),(‘h’,6),(‘i’,7),(‘b’,8),(‘j’,9)

(‘a’,0),(‘f’,1),(‘e’,2),(‘d’,3),(‘i’,4),(‘b’,5),(‘g’,6),(‘h’,7),(‘c’,8),(‘j’,9)

(‘e’,0),(‘f’,1),(‘a’,2),(‘b’,3),(‘h’,4),(‘d’,5),(‘g’,6),(‘i’,7),(‘c’,8),(‘j’,9)

(‘b’,0),(‘c’,1),(‘d’,2),(‘e’,3),(‘h’,4),(‘a’,5),(‘g’,6),(‘i’,7),(‘f’,8),(‘j’,9)

(‘d’,0),(‘c’,1),(‘b’,2),(‘a’,3),(‘i’,4),(‘e’,5),(‘g’,6),(‘h’,7),(‘f’,8),(‘j’,9)

(‘f’,0),(‘a’,1),(‘b’,2),(‘c’,3),(‘g’,4),(‘e’,5),(‘i’,6),(‘h’,7),(‘d’,8),(‘j’,9)

(‘b’,0),(‘a’,1),(‘f’,2),(‘e’,3),(‘h’,4),(‘c’,5),(‘i’,6),(‘g’,7),(‘d’,8),(‘j’,9)

(‘c’,0),(‘b’,1),(‘a’,2),(‘f’,3),(‘g’,4),(‘d’,5),(‘h’,6),(‘i’,7),(‘e’,8),(‘j’,9)

(‘a’,0),(‘b’,1),(‘c’,2),(‘d’,3),(‘i’,4),(‘f’,5),(‘h’,6),(‘g’,7),(‘e’,8),(‘j’,9)

(‘e’,0),(‘d’,1),(‘c’,2),(‘g’,3),(‘f’,4),(‘h’,5),(‘i’,6),(‘b’,7),(‘j’,8),(‘a’,9)

(‘e’,0),(‘h’,1),(‘j’,2),(‘g’,3),(‘f’,4),(‘d’,5),(‘b’,6),(‘i’,7),(‘c’,8),(‘a’,9)

(‘j’,0),(‘h’,1),(‘e’,2),(‘d’,3),(‘i’,4),(‘g’,5),(‘b’,6),(‘f’,7),(‘c’,8),(‘a’,9)

(‘g’,0),(‘c’,1),(‘d’,2),(‘e’,3),(‘f’,4),(‘j’,5),(‘b’,6),(‘i’,7),(‘h’,8),(‘a’,9)

(‘d’,0),(‘c’,1),(‘g’,2),(‘j’,3),(‘i’,4),(‘e’,5),(‘b’,6),(‘f’,7),(‘h’,8),(‘a’,9)

(‘h’,0),(‘j’,1),(‘g’,2),(‘c’,3),(‘b’,4),(‘e’,5),(‘i’,6),(‘f’,7),(‘d’,8),(‘a’,9)

(‘g’,0),(‘j’,1),(‘h’,2),(‘e’,3),(‘f’,4),(‘c’,5),(‘i’,6),(‘b’,7),(‘d’,8),(‘a’,9)

(‘d’,0),(‘e’,1),(‘h’,2),(‘j’,3),(‘i’,4),(‘c’,5),(‘f’,6),(‘b’,7),(‘g’,8),(‘a’,9)

No sooner had the synthetic dust settled in the wake of Zenyatta’s dominating performance in the 2009 Breeders’ Cup Classic at Santa Anita then the flame igniting the “Horse of the Year” debate was rekindled anew.  At question is how to properly award the top honor in U.S. racing when considering the miraculous campaigns of both Zenyatta and the 3-year-old filly sensation Rachel Alexandra. 

At this point in time, It’s become a question I’d really rather not address at all if it were not on the lips of nearly all I’ve spoken with these past few days.  My personal feeling being that this is still Zenyatta’s moment and that at least one full week should pass before we begin doing what horseplayers do – arguing incessantly with one another over our respective levels of insanity.  One can barely get so much as a word in about the Classic right now though without the issue coming up rather directly.  Emotions seem to be running high on both sides of the isle as the immediacy of a supreme moment still actively courses through the furiously beating hearts of racing fans the world over. 

In many ways, the pendulum seems to have swung almost completely.  Where once Rachel was considered (including by yours truly) a mortal lock to have already captured the honor as Horse of the Year by virtue of (most notably) her Preakness, Haskell, and Woodward victories, a new wind has begun to blow.  The much whispered “backlash” against team Rachel for having not attended the Breeders’ Cup had been one element of this change.  The true spark, however, is a bit more noble in nature and seems to stem from a desire to ensure that Zenyatta is properly awarded for the undefeated career she has blessed us with. 

As early as Saturday night, the battle lines were already being drawn.  Attending a post-Classic dinner with folks from the TVG Community (the organizers for which I owe a great deal of thanks to for a wonderful weekend, along with those at both the NTRA and the Breeders’ Cup), I was asked for my opinion, and admittedly I balked a bit – attempting to play the classical Switzerland “neutrality defense.”  Like many a smaller European nation state in the opening half the 20th century, I ultimately found myself being drawn, however unwittingly, into the great conflagration.

Not to be confused with the famous "French defense" in chess, the "Switzerland neutrality posture" in the great 2009 Horse of the Year debate is ultimately indefensible.

At the end of the day, I suppose someone does have to win the award, right?  

So whom do we chose?

As much as I’ve tried to play the Switzerland defense, it’s probably rightly noted that I’m an ever-so-slightly bigger fan of Rachel Alexandra than I am of Zenyatta.  I think that’s a fair assessment of my own emotional makeup.  That’s not to say I don’t love Zenyatta with all my heart – always have and always will – but my record of pro-Rachel Alexandra coverage is something I cannot deny being consciously aware of.  

That being said, I’ve loved Zenyatta since I spotted her profile prior to her maiden debut, noting “hey, that’s the same connections as Giacomo – I might take a shot with this girl!”  In time she became my “slow cheetah” – a name and a song that will forever have a special meaning to me.

I care about these two fillies so deeply that I consider it the honor of a lifetime to have been there for the finer moments of each one’s 2009 campaign;  Rachel in the Preakness and the Haskell, and Zenyatta in the Classic. 

Much like I had been calling for a dead heat had the two ever locked horns on the track, I find myself utterly divided over who I would select as Horse of the Year.  I suppose to extract a full answer from me, one might have to subject me to brutal interrogation, straight out of the famed Russian Roulette scene in The Deer Hunter.  Tying me to a chair, constantly slapping my face whilst shouting “Mao!” and demanding that I make a selection.  I believe what follows is what my ultimate decision would be under such duress (apart from arising from said chair and declaring “3 bullets!!! We play with 3 bullets!” in classical De Niro fashion):

• Rachel Alexandra for 3-year-old filly champion
• Zenyatta for Horse of the Year

Mao! Robert De Niro in the famous Russian Roulette scene from The Deer Hunter

Truth be told, I actually do believe that Rachel Alexandra had the superior overall year (with “overall” being the operative term), however Zenyatta clearly won the superior race. 

Rachel’s year had more than one signature moment.  She was the first filly in 85 years to win the Preakness.  She was the 2nd filly in 42 years to win the Haskell.  She nearly broke the track record in the Mother Goose, coming close to the exploits of Secretariat at the same distance.  Then, of course, she became the first 3-year-old filly to defeat older males in a stakes race of more than a mile on dirt since the inception of graded stakes in the U.S.

Zenyatta’s overall campaign for 2009 was a bit less heralded – until her triumph in the Classic that is.  I doubt strongly that anyone will think back to her earlier races in the year and point to them as having been signature – but she did remain undefeated, even when carrying  ridiculous amounts of weight and when it seemed to all observing that her undefeated record was in it’s greatest peril at the hands of Anaaba’s Creation.  Somehow, someway, she ALWAYS found a way to win.

So if Rachel’s campaign is the one I believe to be more accomplished, why make Zenyatta Horse of the Year?

Because at some level, even if it has not historically been the case, the Breeders’ Cup Classic should be the deciding moment.  The quintessential test of an overall champion.  Moreover, the career that Zenyatta rewarded us with is one that is deserving of top honors.  And it’s not like she didn’t race in 2009.  She just didn’t race a whole heckuva a lot of times, nor did she put herself in tremendously challenging positions where victory was assumed to be anything other than a foregone conclusion until her date with destiny in the Classic.

I know that technically it isn’t right to attach emotional sentiment to that which she accomplished in 2008 and then factor that into the equation, but how can one not help but do so?  In all likelihood she left us with her career defining performance on the sports biggest stage (at least the biggest stage for true fans of racing, as opposed to the Warhol-esque 2 minutes of national attention associated with the annual running of the Kentucky Derby) – a perfect story book ending to a career that will from henceforth be the measuring stick for all older fillies and mares that attempt to follow in her hoofsteps.

Likewise, Rachel Alexandra will go down as the new barometer by which all subsequent 3-year-old fillies will be compared.  Make no mistake about it, we’ll still invoke memories of Ruffian as well, who will continue to be the greatest of the great fillies, but my sense of things is that Rachel’s ability to both win a 3-year-old Classic (the Preakness) and then follow that up with repeat performances over 3-year-old males in the Haskell and then older males in the Woodward will cement her legacy for years (if not decades) to come.

The mere fact that Rachel is sometimes mentioned in the same breath as Ruffian speaks volumes for how lofty her star has risen.  Just a year ago you probably would’ve been diagnosed as certifiably mad if you dared to publicly compare any filly to Ruffian.  Now people do so without batting an eye.   I’ve refrained from making any direct comparisons myself, as I think it wise to the let the historical greats stand alone, and if nothing else become larger than the legends they were in their own time rather than replaced by newcomers and diminished in legend, but certainly folks reading this have at least heard those comparisons elsewhere and know what I’m referring to.  The point being not whether they are warranted or not, but merely an acknowledgement that such comparisons do exist.

For Rachel, there will be a 2010, and a chance to show she is capable of winning a Breeders’ Cup Classic of her own.  For Zenyatta, the Classic was in all likelihood her swan song. 

What better way to send off a legend than to allow their final chapter to be an ultimate achievement?  It just feels like the right thing to do.

As much as I love them both and am torn asunder in attempting to make a definitive statement one way or the other – I think the right thing to do is to send Zenyatta off to retirement as the 2009 Horse of the Year.  After all, she started the year as the top older female in racing, and nobody was able to defeat her.  Looking at things that way, and reducing the equation to it’s most simplistic component, it’s a bit hard to justify knocking her from her lofty perch – doubly so in the immediate aftermath of her finest hour. 

And you know what?  At the end of the day it’s really just a silly award.  What these two ladies accomplished on the track will be remembered for years regardless of whether an additional trophy is added to their respective cases.

Respect for each of them has been EARNED on the track, not GIVEN at some awards ceremony.

That’s how I see things at least.  What say you?  Who do you think ought to receive the Eclipse Award for 2009 Horse of the Year?

The Zebra Puzzle is a decades-old exercise in deductive logic. Unfortunately, I lack the patience to sit down and solve this kind of puzzle. So in this post, we’re going to cheat by teaching Haskell to solve it for us.

> import Data.Maybe
> import Control.Monad

We will take our cue from this solution written in SWI Prolog, and encode our puzzle as a set of constraints that our solving code must satisfy.

An ‘entry’ is a single entity in the solution. In the Zebra puzzle, these are going to be the individual houses. For maximum generality, we’re just going to represent all the properties of the entries with strings.

An answer to the puzzle is a collection of several entities which together satisfy all of the rules set forth in the puzzle description.

> type Entry  = [String]
> type Answer = [Entry]

I was going to explain the rule types at this point, but the explanation ended up being a lot harder to understand than just looking at the rules for this puzzle, so we’ll do that instead.

The first four rules simply teach our solver about numbers. After these rules are satisfied, the entries in the solution will be numbered one through five.

> rules =
>   [ Follows  [ "1", "",        "",       "",       "",       ""              ]
>              [ "2", "",        "",       "",       "",       ""              ]
>   , Follows  [ "2", "",        "",       "",       "",       ""              ]
>              [ "3", "",        "",       "",       "",       ""              ]
>   , Follows  [ "3", "",        "",       "",       "",       ""              ]
>              [ "4", "",        "",       "",       "",       ""              ]
>   , Follows  [ "4", "",        "",       "",       "",       ""              ]
>              [ "5", "",        "",       "",       "",       ""              ]

Then we specify all of the clues that make up the puzzle itself. These are given in order, so it should be easy to see the correspondence with the clues listed in the wikipedia article

>   , Literal  [ "",  "England", "",       "",       "Red",    ""              ]
>   , Literal  [ "",  "Spain",   "Dog",    "",       "",       ""              ]
>   , Literal  [ "",  "",        "",       "Coffee", "Green",  ""              ]
>   , Literal  [ "",  "Ukraine", "",       "Tea",    "",       ""              ]
>   , Follows  [ "",  "",        "",       "",       "Green",  ""              ]
>              [ "",  "",        "",       "",       "Ivory",  ""              ]
>   , Literal  [ "",  "",        "Snails", "",       "",       "Old Gold"      ]
>   , Literal  [ "",  "",        "",       "",       "Yellow", "Kools"         ]
>   , Literal  [ "3", "",        "",       "Milk",   "",       ""              ]
>   , Literal  [ "1", "Norway",  "",       "",       "",       ""              ]
>   , Adjacent [ "",  "",        "",       "",       "",       "Chesterfields" ]
>              [ "",  "",        "Fox",    "",       "",       ""              ]
>   , Adjacent [ "",  "",        "",       "",       "",       "Kools"         ]
>              [ "",  "",        "Horse",  "",       "",       ""              ]
>   , Literal  [ "",  "",        "",       "Juice",  "",       "Lucky Strike"  ]
>   , Literal  [ "",  "Japan",   "",       "",       "",       "Parliaments"   ]
>   , Adjacent [ "",  "Norway",  "",       "",       "",       ""              ]
>              [ "",  "",        "",       "",       "Blue",   ""              ]

Unfortunately, one drink and one animal are missing from the rules as stated, so here we just inform the solver “someone drinks water” and “someone owns a zebra”

>   , Literal  [ "",  "",        "",       "Water",  "",       ""              ]
>   , Literal  [ "",  "",        "Zebra",  "",       "",       ""              ]
>   ]

So we have three kinds of rules, for which we’ll need a data definition. By now it should be self-evident how each of these work

> data Rule = Literal  Entry
>           | Adjacent Entry Entry
>           | Follows  Entry Entry
>           deriving (Show)

At this point, we have a nice, declarative specification of what a solution will look like, and we need to write the code to solve for it. The key to solving the puzzle efficiently is to realize that each rule is effectively describing some small portion of a possible answer, with empty strings representing unknown values. What we need next is a way to expand a rule into a list of all those answers that it represents

> expandRule :: Int -> Rule -> [Answer]
> expandRule n (Literal   a ) = [ expand n [ a ] x | x <- [0 .. n - 1] ]
> expandRule n (Follows  a b) = [ expand n [a,b] x | x <- [0 .. n - 2] ]
> expandRule n (Adjacent a b) = concat [e $ Follows a b, e $ Follows b a]
>   where e = expandRule n
>
> expand :: Int -> [Entry] -> Int -> [Entry]
> expand n rs@(r:_) x = replicate x blank ++ rs ++ replicate (n - x - 1) blank
>   where blank = replicate (length r) ""

As we go about solving the puzzle, we will at all times have a collection of answers the solver currently knows to be possible, and a set of answer fragments resulting from expanding the rule we’re currently trying to satisfy. What we need is a way to test every possible combination of the old answers with the new answer fragments.

Our solution will make use of the nondeterminism monad, called the “list” monad by the unenlightened. As we iterate over the rules, we will expand each one in turn, test every possible combination with the old answers, and then filter out the impossible ones.

At first, this will cause a combinatorial explosion of possible answers, but as new rules are added, we will eventually reach a point where each additional rule manages only to decrease the number of possible solutions, until there is only one remaining.

> applyRules :: Answer -> [Rule] -> [Answer]
> applyRules answer rules = foldM applyRule answer rules
>   where applyRule a r = catMaybes [overlay a x | x <- expandRule (length a) r]

From the definition of applyRules, it is clear that our overlay operation needs to have type Answer -> Answer -> Maybe Answer. If any two answers are both defined and different from each other, we return Nothing, and otherwise we return the most defined of the two fields.

> overlay :: Answer -> Answer -> Maybe Answer
> overlay old new = sequence $ zipWith overlay' old new
>   where overlay' old new = sequence $ zipWith overlay'' old new
>         overlay'' "" ""  = Just ""
>         overlay'' "" n   = Just n
>         overlay'' o  ""  = Just o
>         overlay'' o  n
>           | o == n       = Just o
>           | otherwise    = Nothing

Before any constraints are applied, the answer is entirely undefined, so the process of solving consists simply of applying all the rules to an initial empty answer, and seeing what results. In this case, there is only one answer, but removing one or more rules from the list can make other solutions equally valid.

> main = showAnswers . applyRules emptyAnswer $ rules
>   where emptyAnswer = replicate 5 . replicate 6 $ ""
>         showAnswers = mapM_ $ mapM_ print

To see how each additional rule changes the set of possible answers, you can try something like “mapM_ print . applyRules emptyAnswer . take ## $ rules” in GHCi, for all the numbers between 1 and 20.

(This post is Literate Haskell, meaning that it can be copied and pasted in its entirety into a *.lhs file, and then run with runhaskell)

Effects of Intuition

In the march of pure functional programming toward pervasive mainstream use the notion of effects have become an interesting topic. I’ve begun looking at what you might call “the effect spectrum” or “the effect zoo”: the different kinds of effects and what they do (to your program).

I shall name these functions by personal preference, these names are likely unconventional but they have “symbolic” value.The first examples will not be effects at all but I will gradually move into effects over the next few posts, well maybe just one more post. I have a few ideas queued up on time-slicing, “forced” pre-emption (OS terminology abuse alert) and exceptions.

The structural notation will be a “pseudo/semi-formalism”, Haskell-like.

Exhibit 1: Non [ineffective]

This function takes no arguments, computes nothing, does nothing and returns no result. It is the computational equivalent of brain death.

structure

() → ()

substance

public void non()
{
}

Exhibit 2: Som [ineffective]

This function takes one argument and returns that argument. The “zero” function may be seen as a special case of the “one” function, accepting only the empty tuple.

structure

a → a

substance

public void som<T> (T x)
{
  return x;
}

Exhibit 3: Som-Non [ineffective]

This function takes one argument and returns nothing as a result, never caring about what the argument actually was, you might call this a comatose function: it gets everything you say but can’t respond back with anything (the empty tuple () being the equivalent of silence).

structure

a → ()

substance

public void somnon<T> (T x)
{
}

Exhibit 4: Non-Som [ineffective]

This function takes nothing and returns something. It is the dual of comatose – it can only give and it always gives the same thing.

structure

() → a

substance

public T nonsom<T>()
{
   return default(T);
}

Exhibit 5: Som-Time [time-"in"-effective]

This function takes something and returns that same thing, after some time. You might say it’s the functional equivalent of bullet-time; it slows down time (if e.g. we define time as state-transitions; ticks, or whatever). This means it has an effect, meaning its “effective” but this time-effect also makes it “in-effective”.

structure

a → Δ a

substance

public T somtime<T>(T x)
{
   Thread.Sleep(1000);
   return x;
}

One may argue whether this function actually contains a [side-]effect (messing with time) or not. In a sense all functions mess with time, as in the real world they take time to compute. So the result is some delta into the future where the argument is some point in the past, depending on when you look at it.

I’ve created a new version of BlogLiterately, now on hackage. The new version is quite similar to what I blogged about here, with some enhancements:

• it now supports categories.
• it now supports highlighting-kate, if you’ve installed Pandoc with highlighting support.
• you can highlight Haskell with hscolour using CSS classes or inline styles.
• you can highlight Haskell and non-Haskell with highlighting-kate (via Pandoc). (But only via CSS classes and a separate or embedded stylesheet, not via inline styles. So it does me personally no good!).

I contemplate a future upgrade will allow highlighting-kate marked up code to have the CSS class-based styling ‘baked’ into the HTML in a way similar to how I handle hscolour.

Anyone who enjoys this tool, thank the authors of Pandoc, hscolour, HaXml, HaXR and, of course, GHC and the Haskell Platform, as this program is just a bit of glue that binds these much bigger pieces together for one simple application.

フィボナッチ。

-- | fibonacci sequence
fibonacci :: (Num a) => [a]
fibonacci = [1, 2] ++ zipWith (+) fibonacci ( tail fibonacci )

-- problem 25
pe025 = head $ dropWhile (\ x -> snd x < 10^(1000-1)) $ zip [2,3..] fibonacci

• snd　　タプルの二番目を得る

順列を辞書順に並べ、その10000000番目を求める。
まともに全部列挙してみる。

-- problem 24
perm [] = []
perm (x:[]) = [[x]]
perm (xs) = concat . zipWith (make_perms) xs . map (\ x -> xs \\ [x]) $ xs
    where make_perms a xs = map (a : ) . perm $ xs

pe024 = concat $ map show $ (perm [0..9]) !! (1000000 - 1)

• \\　　リストの差。リストから要素を取り除く
• concat　　リストを繋ぎあわせる。リストが一段階少なくなる
• !!　　リストの要素をインデックスで指定して得る　最初の要素は０番目

今回も、Integerのおかげでなんとも無い問題。

factorial = product . (enumFromTo 1)
pe020 = sum $ map digitToInt $ show . factorial $ 100

ここのブログは、ソースコードが張りつけられる訳ですが、haskellには対応してません。WordPressでHaskellを色づけする方法はあるようですが、ここは、無料WordPressサービスなので、改造出来るのか判りませんし。

で、無理矢理、Haskellコードを色づけ。ちょっと試した結果、python、sql、delphiくらいがよさそう。

で、以下はpython。

numOfDay :: Int -> Int -> Int
numOfDay 2 year
         = if year `mod` 4 == 0 && ((year `mod` 100 /= 0) || (year `mod` 400 == 0) )
           then 28
           else 29
numOfDay month _
         = if month == 4 || month == 6 || month == 9 || month == 11
           then 30
           else 31

sql。

data Date = Date {
                    day    :: Int,
                    month  :: Int,
                    year   :: Int,
                    week   :: Week
                }
                deriving Show

data Week = Mon | Tue | Wed | Thu | Fri | Sut | Sun deriving (Show, Eq)

weekToDigit :: Week -> Int
weekToDigit Mon = 0
weekToDigit Tue = 1
weekToDigit Wed = 2
weekToDigit Thu = 3
weekToDigit Fri = 4
weekToDigit Sut = 5
weekToDigit Sun = 6

digitToWeek :: Int -> Week
digitToWeek 0 = Mon
digitToWeek 1 = Tue
digitToWeek 2 = Wed
digitToWeek 3 = Thu
digitToWeek 4 = Fri
digitToWeek 5 = Sut
digitToWeek 6 = Sun
digitToWeek num = digitToWeek $ num `mod` 7

calcWeek :: Week -> Int -> Week
calcWeek w num = digitToWeek $ num + weekToDigit w

delphi。

initDay = (Date 1 1 1900 Mon)

-- 指定の日付の次の月の日付が、何曜日になるか
nextMonth :: Date -> Date
nextMonth (d@(Date {month = m, year = y, week = w}) )
    = d {month = m2, year = y2, week = w2}
      where
        m2 = (m `mod` 12) + 1
        y2 = if m == 12 then y+1 else y
        w2 = calcWeek w numOfDay
        numOfDay = 30

pe019 = length $ filter (== Sun) $ map week $ takeWhile (\x -> year x <= 2000) $ dropWhile (\x -> year x <= 1900) $ iterate nextMonth initDay

そういえばProjectEulerだった。
今回も手こずる。

結局、日、月、年、曜日を格納する型を作る。で、与えられた曜日が判っていれば、そこから指定の日数だけ経った日の曜日も、mod 7 で求める事が出来る。
問題は、それぞれの月が、30なのか、31なのか、28か、、、

• data　　ユーザー定義型の定義
• deriving
• @パターン

Dzisiejszy wpis jest tłumaczeniem Blogging Literately in Haskell Roberta Greayera.

Napisałem jeden post na blogu o Haskellu i stwierdziłem, że jest to zdecydowanie zbyt uciążliwe. Ten WYSIWYG tinyMCE edytor z WordPressa jest beznadziejny, przynajmniej jeśli chodzi o fromatowanie fragmentów kodu, a chyba bym umarł, gdybym musiał bezpośrednio wpisywać HTMLa do WordPressa. Czułem, że musi istnieć lepszy sposób, rozglądnąłem się za aplikacją zaspokajającą moje potrzeby. Odrzuciłem kilka edytorów, darmowych i komercyjnych, niektóre były beznadziejne, niektóre prawie nadawały się do użytku, ale żaden nie pozwalał na połączenie Haskella i narracji tak łatwo, jak to powinno być zrobione. Naprawdę potrzebuję prostego sposobu na przekształcenie Haskella w trybie literackim (wiecie, takich artykułów z zupełnie nieznanych przyczyn nagle przerywanych

> {-# LANGUAGE DeriveDataTypeable #-}
> module Main where

takimi dziwnymi wtrąceniami), być może z prostym tekstem w stylu markdown. Potem niech taki tekst magicznie wrzuca na blog, z dobrym formatowaniem HTML i sekcjami kodu Haskella.

Teoretycznie Haskell posiada wszelakie biblioteki wykonujących najprzeróżniejsze zadania. Być może nie byłoby zbyt trudno zmontować z dostepnych bibliotek coś takiego, co by robiło dokładnie to co mi potrzebne.

W niewyjaśniony sposób zaabsorbowałem przez osmozę z eteru, że isnieje haskellowe narzędzie nazywane Pandoc, autorstwa Johna McFairlanea, które potrafi zająć się markdownem, HTMLem i innymi formatami. Jest ono, jak wszystkie dobre rzeczy, dostępne na Hackage, jednocześnie jako program i jako biblioteka. Wygląda na dobry początek.

> import Text.Pandoc

Przeglądając dokumentację Pandoc zauwazyłem, że chociaż potrafiło robić niesamowite rzeczy z ogromną ilością formatów, niestety nie potrafiło automatycznie przetwarzać kodu Haskella. A ja chciałem, żeby źródło wyglądało jak dokumentacja Haddock, dokładniej jak dokumentacja na Hackage. Haddock używa Hscoulour, narzędzia napisanego przez Malcolma Wallace przeznaczonego do kolorowania kodu źródłowego.

> import Language.Haskell.HsColour(hscolour,Output(..))
> import Language.Haskell.HsColour.Colourise(defaultColourPrefs)

Zakładając, że Pandoc i hscolour mnie zadowolą, będę jeszcze potrzebował sposobu na publikację na blogu. Po chwili googlowania znalazłem informację, że mój blog wspiera coś nazywanego MetaWeblog API, czyli blogowy protokół bazowany na XML-RPC.

Istnieje biblioteka XML-RPC autorstwa Bjorna Bringerta nazwana HaXR (oczywiście na Hackage), która wydaje się być odpowiednia.

> import Network.XmlRpc.Client
> import Network.XmlRpc.Internals

Będę potrzebował jeszcze kilku rzeczy. Ponieważ tworzę narzędzie obsługiwane z linii poleceń, przyda się parser argumentów, a biblioteka Neila Mitchela CmdArgs powinna być odpowiednia:

> import System.Console.CmdArgs

W końcu będę też musiał manipulować formatem XHTML, więc użyję biblioteki kombinatorów HaXml Malcolma Wallacea:

> import Text.XML.HaXml
> import Text.XML.HaXml.Verbatim

Potrzebuję też wykonać trochę tekstowego wejścia wyjścia w kodowaniu UTF8, co prowadzi mnie do niezastąpionej (aż do GHC 6.12!) biblioteki Erica Martensa utf8-string:

> import qualified System.IO.UTF8 as U

I jeszcze kilka drobniejszych rzeczy:

> import Control.Monad(liftM,unless)
> import Text.XHtml.Transitional(showHtml)
> import Text.ParserCombinators.Parsec
> import Debug.Trace

Program, który sobie wyobrażam, wczyta plika Haskella w formacie literackim, użyje Pandoc w tryie markdown, w jakiś sposób znajdzie bloki kodu na wejściu, użyje na nich hscolour. Pandoc przemienia swoje wejście w strukturę typu:

data Pandoc = Pandoc Meta [Block]

gdzie Block (w każdym razie jego interesująca część) to:

-- | Block element.
data Block
    = Plain [Inline]        -- ^ Tekst, ale nie paragraf
    | Para [Inline]         -- ^ Paragraf
    | CodeBlock Attr String -- ^ Fragment kodu (dosłownie) z atrybutami
    | RawHtml String        -- ^ Surowy HTML
    | BlockQuote [Block]    -- ^ Cytowanie blokowe
    | OrderedList ListAttributes [[Block]] -- ^ Numerowana lista z atrybutami 
                            -- i elementami (każdy to lista bloków)
    | BulletList [[Block]]  -- ^ Punktowana lista (lista elementów, każdy z nich
                            -- to lista bloków)
    | DefinitionList [([Inline],[Block])]  -- ^ Lista definicyjna
                            -- (lista elementów, każdy to para tekstu i listy bloków)
    | Header Int [Inline]   -- ^ Nagłówek - poziom (liczba) i tekst
    | HorizontalRule        -- ^ Pozioma linia podziału
    | Table [Inline] [Alignment] [Double] [[Block]] [[[Block]]]  -- ^ Tablica,
                            -- z tytułami, justowaniem kolumn,
                            -- relatywną szerokością kolumn i ich nagłówków
                            -- (każdy to lista bloków), i rzędów
                            -- (każdy to lista list bloków)
    | Null                  -- ^ Puste
    deriving (Eq, Read, Show, Typeable, Data)

Literacki Haskell, który znajduje Pandoc w pliku trafia do różnych elementów CodeBlock w dokumencie Pandoc. Inny kod również może się tam znaleźć, jeśli był normalnie sformatowanym markdownem. Literacki Haskell rozróżniamy dzięki innemu składnikowi Attr, który ma postać:

type Attr = (String, [String], [(String, String)])

Jak pokazują eksperymenty, CodeBlock który ma Attr postaci (_,["sourceCode","haskell"],_) jest literackim fragmentem kodu Haskella, natomiast inne elementy CodeBlock są markdownem. Chcę podświetlanie składni w obu rodzajach bloków, ale kiedy będą renderowane do HTMLa chcę zachować konwencję literackiego Haskella (czyli chcę dołożyć znaczek > na początku każdej linii). Właściwie to nawet chcę więcej…

Gdy piszę literackiego Haskella, mogę chcieć załączyć nie-Haskell, ale jednak kod w tekście. Przykłady jak ten sam fragment napisać w ML, albo przykłady jak uruchomić program. Nie każdy blok powinien być podświtlany przez hscolour, tylko kod Haskella. Markdown nie pozwala na opis jakiego języka jest dany fragment kodu, ale skoro i tak obrabiam poszczególne bloki, mogę przyjąć prostą konwencję. Jeśli fragmenty wygląda tak:

[haskell]
foo :: String -> String

to jest to blok Haskella. Jeśli wygląda inaczej:

[C++]
cout << "Hello World!";

lub

[other]
foo bar baz

wtedy zakładamy, że jest to coś innego.

Mogę usunąć typ bloku z początku każdego bloku, który przygotowuję do pokolorowania. Używam Parseca do rozpoznania tagu otwierającego:

> unTag :: String -> (String, String)
> unTag s = either (const ("",s)) id $ parse tag "" s
>    where tag = do
>              tg <- between (char '[') (char ']') $ many $ noneOf "[]"
>              skipMany $ oneOf " t"
>              (string "\r\n" <|> string "\n")
>              txt <- many $ anyToken
>              eof
>              return (tg,txt)

Aby podświetlić składnię przy użyciu hscolour (który produkuje HTML), potrzebuję przetworzyć String z elementu CodeBlock na String odpowiedni dla RawHtml. Pandoc usuwa znak > z początku każdej linii, więc muszę go dodać spowrotem, a także poinformować hscolour czy jest to literacki Haskell czy też nie. Funkcja hscolour wygląda tak:

hscolour :: Output      -- ^ Format wyjściowy
         -> ColourPrefs -- ^ Kolorystyka
         -> Bool        -- ^ Czy generować odnośniki
         -> Bool        -- ^ Czy wyściowy dokument jest częściowy czy zamknięty
         -> String      -- ^ Tytuł
         -> Bool        -- ^ Czy wejściowy dokument jest literacki czy nie
         -> String      -- ^ Kod źródłowy Haskella
         -> String      -- ^ Koloryzowany kod źródłowy Haskella

Hscolour wspiera kilka styli HTMLa: HTML, CSS i ICSS. HTML to HTML z tagami font, które są narzędziem szatana, więc ominąłem tę opcję szerokim łukiem. CSS to formatowanie HTML przy użyciu styli, które pozwala na elastyczność użycia osobnego arkusza stylu. ICSS to ‘inline-CSS’, czyli dokładnie to, czego potrzebuję dla mojego WordPressowego bloga, gdyż nie zamierzam płacić $15 rocznie za przywilej posiadania własnego cssa na ich stronie. Niestety, opcje styli hscolour dla trybu ICSS są dosyć ograniczone, ale wymyśliłem nieco bardziej zagmatwany sposób na przerobienie CSSowo kolorowanego kodu źródłowego na ‘inline-css’ HTML. Zacznę więc od użycia hscolour w trybie CSS do przetwarzania mojego źródła:

> colourIt literate srcTxt =
>     hscolour CSS defaultColourPrefs False True "" literate src'
>     where src' | literate = prepend srcTxt
>                | otherwise = srcTxt

Dołączenie znaczników literackiego Haskella na początku każdej linii jest trywialne:

> prepend s = unlines $ map p $ lines s where p s = '>':' ':s

Hscolour używa elementów SPAN w HTML i klas CSSa takich jak ‘hs-keyword’ lub ‘hs-keyglyph’. Ja chcę wziąć każdy oznaczony tak element SPAN i zamienić jego atrybut class na styl bezpośrednio na elemencie zgodnie z moim upodobaniem. Możliwości stylu opisuje typ:

> data StylePrefs = StylePrefs {
>     keyword  :: String,
>     keyglyph :: String,
>     layout   :: String,
>     comment  :: String,
>     conid    :: String,
>     varid    :: String,
>     conop    :: String,
>     varop    :: String,
>     str      :: String,
>     chr      :: String,
>     number   :: String,
>     cpp      :: String,
>     selection :: String,
>     variantselection :: String,
>     definition :: String
>     } deriving (Read,Show)

Każde pole powyższego będzie zawierało oczekiwany styl dla klasy HTML, którą hscolour przypisze fragmentowi kodu. Domyślny styl, taki jak ma Hackage, wygląda tak:

> defaultStylePrefs = StylePrefs {
>     keyword  = "color: blue; font-weight: bold;"
>   , keyglyph = "color: red;"
>   , layout   = "color: red;"
>   , comment  = "color: green;"
>   , conid    = ""
>   , varid    = ""
>   , conop    = ""
>   , varop    = ""
>   , str      = "color: teal;"
>   , chr      = "color: teal;"
>   , number   = ""
>   , cpp      = ""
>   , selection = ""
>   , variantselection = ""
>   , definition = ""
>   }

Można wczytać preferencje stylu z pliku przy użyciu instancji Read dla StylePrefs. Możnaby lepiej zatroszczyć się o błędy, ale poniższe powinno zadziałać:

> getStylePrefs "" = return defaultStylePrefs
> getStylePrefs fname = liftM read (U.readFile fname)

Hscolour zwraca HTML jako String. Żeby go przetworzyć, trzeba sparsować, przetworzyć, potem znowu zrenderować do Stringa. Teraz użyję HaXml:

> xformXml :: StylePrefs -> String -> String
> xformXml prefs s =  verbatim $ filtDoc (xmlParse "input" s) where
>     -- filter the document (an Hscoloured fragment of Haskell source)
>     filtDoc (Document p s e m) =  c where
>         [c] = filts (CElem e)
>     -- the filter is a fold of individual filters for each CSS class
>     filts = foldXml $ foldl o keep [
>             filt "keyword" keyword,
>             filt "keyglyph" keyglyph,
>             filt "layout" layout,
>             filt "comment" comment,
>             filt "conid" conid,
>             filt "varid" varid,
>             filt "conop" conop,
>             filt "varop" varop,
>             filt "str" str,
>             filt "chr" chr,
>             filt "num" number,
>             filt "cpp" cpp,
>             filt "sel" selection,
>             filt "variantselection" variantselection,
>             filt "definition" definition
>         ]
>     -- an individual filter replaces the attributes of a tag with
>     -- a style attribute when it has a specific 'class' attribute.
>     filt lbl f =
>         replaceAttrs [("style",f prefs)] `when`
>             (attrval $ ("class",AttValue [Left ("hs-" ++ lbl)]))

Aby w pełni pokolorować CodeBlock możemy stworzyć funkcję transformującą CodeBlock do RawHtml, gdy zawartość zawiera kod źródłowy Haskella:

> colouriseCodeBlock prefs (CodeBlock attr@(_,inf,_) s) =
>     if tag == "Haskell" || lit
>         then RawHtml $ xformXml prefs $ colourIt lit s'
>         else CodeBlock attr s'
>     where (tag,s') = trace (show s) $ unTag s
>           lit = "sourceCode" `elem` inf && "haskell" `elem` inf
> colouriseCodeBlock _ b = b

A kolorowanie dokumentu Pandoc to po prostu:

> colourisePandoc prefs (Pandoc m blocks) =
>     Pandoc m $ map (colouriseCodeBlock prefs) blocks

Przetworzenie pełnego dokumentu na wejściu do wyjścia HTML to:

> xformDoc :: StylePrefs -> String -> String
> xformDoc prefs s =
>     showHtml
>     $ writeHtml writeOpts -- from Pandoc
>     $ colourisePandoc prefs
>     $ readMarkdown parseOpts -- from Pandoc
>     $ fixLineEndings s
>     where writeOpts = defaultWriterOptions {
>               writerLiterateHaskell = True,
>               writerReferenceLinks = True }
>           parseOpts = defaultParserState {
>               stateLiterateHaskell = True }
>           -- readMarkdown is picky about line endings
>           fixLineEndings [] = []
>           fixLineEndings ('\r':'\n':cs) = '\n':fixLineEndings cs
>           fixLineEndings (c:cs) = c:fixLineEndings cs

Teraz, skoro już potrafię stworzyć dokument, musże jeszcze umieć wysłać go na blog. MetaWeblog API definiuje metody newPost oraz editPost:

metaWeblog.newPost (blogid, username, password, struct, publish) returns string
metaWeblog.editPost (postid, username, password, struct, publish) returns true

Dla mojego blogu (WordPressowego), blogid jest domyślne. Nazwa użytkownika i hasło to po prostu napisy, a publish to flaga określająca, czy od razu opublikować wpis. Postid to identyfikator, który jest automatycznie nadawany nowemu wpisowi. Interesujące jest pole struct, które jest strukturą XML-RPC opisującą wpis łącznie z paroma metadanymi, na przykład tytułem. Aby stworzyć tę strukturę potrzebuję tytułu i treści:

> mkPost title text =
>     [("title",title),("description",text)]

Biblioteka HaXR zawiera funkcję do wykonania zdalnej procedury XML-RPC:

remote :: Remote a =>
    String -- ^ Server URL. May contain username and password on
           --   the format username:password@ before the hostname.
       -> String -- ^ Remote method name.
       -> a      -- ^ Any function 
     -- @(XmlRpcType t1, ..., XmlRpcType tn, XmlRpcType r) => 
                 -- t1 -> ... -> tn -> IO r@

Funkcja jako argumentów potrzebuje URLa i nazwy metody. Zwraca funkcję typu Remote a => a. Wnioskując z instancji klasy Remote możemy użyć dowolnej funkcji przyjmującej zero lub więcej parametrów klasy XmlRpcType i zwracająca XmlRpcType r => IO r. Po prostu możesz funkcję remote wywołać z dowolną ilością argumentów porzebnych procedurze zdalnej. Jeśli wywołanie zrobisz w kontekście IO, nadany zostanie właściwy typ. Zatem żeby wywołać metaWeblog.newPost trzeba użyć następującej procedury:

> postIt :: String -> String -> String -> String -> String -> String -> Bool -> IO String
> postIt url blogId user password title text publish =
>     remote url "metaWeblog.newPost" blogId user password (mkPost title text) publish

Procedura uaktualniająca (zamieniająca) wpis ma postać:

> updateIt :: String -> String -> String -> String -> String -> String -> Bool -> IO Bool
> updateIt url postId user password title text publish =
>     remote url "metaWeblog.editPost" postId user password (mkPost title text) publish

Większość puzzli jest już na miejscu. Teraz trzeba całość przekształcić w program linii poleceń. Kontrolę przy uzyciu opcji opisuje następujący typ:

> data BlogLiterately = BlogLiterately {
>        style :: String,    -- name of a style file
>        publish :: Bool,    -- an indication of whether the post should be
>                            -- published, or loaded as a draft
>        blogid :: String,   -- blog-specific identifier (e.g. for blogging
>                            -- software handling multiple blogs)
>        blog :: String,     -- blog xmlrpc URL
>        user :: String,     -- blog user name
>        password :: String, -- blog password
>        title :: String,    -- post title
>        file :: String,     -- file to post
>        postid :: String    -- id of a post to updated
>     } deriving (Show,Data,Typeable)

Przy użyciu CmdArgs i poniższej magii definiuję jak zachowują się argumenty linii poleceń:

> bl = mode $ BlogLiterately {
>     style = "" &= text "Style Specification" & typFile,
>     publish = def &= text "Publish post",
>     blogid = "default" &= text "Blog specific identifier",
>     blog = def &= argPos 0 & typ "URL"
>         & text "URL of blog's xmlrpc address (e.g. http://example.com/blog/xmlrpc.php)",
>     user = def &= argPos 1 & typ "USER" & text "blog author's user name" ,
>     password = def &= argPos 2 & typ "PASSWORD" & text "blog author's password",
>     title = def &= argPos 3 & typ "TITLE",
>     file = def &=  argPos 4 & typ "FILE" & text "literate haskell file",
>     postid = "" &= text "Post to replace (if any)"}

Główna funkcja blogująca używa informacji zawartej w powyższym typie, żeby przeczytać styl z pliku, wprowadzić źródło w postaci literackiego Haskella, odpowiednio przetworzyć, a na końcu wysłać bezpośrednio na bloga:

> blogLiterately (BlogLiterately style pub blogid url user pw title file postid) = do
>     prefs <- getStylePrefs style
>     html <- liftM (xformDoc prefs) $ U.readFile file
>     U.writeFile "output.html" html
>     if null postid
>         then do
>             postid <- postIt url blogid user pw title html pub
>             putStrLn $ "post Id: " ++ postid
>         else do
>             result <- updateIt url postid user pw title html pub
>             unless result $ putStrLn "update failed!"

Głowny program to po prostu:

> main = cmdArgs "Blog Literately v0.1, (C) Robert Greayer 2009" [bl] >>= blogLiterately

Uruchomienie bez opcji wyświetli pomoc:

 [cmdline]
 $ ./BlogLiterately --help
 Blog Literately v0.1, (C) Robert Greayer 2009

 blogliterately [FLAG] URL USER PASSWORD TITLE FILE

  -? --help[=FORMAT]  Show usage information (optional format)
  -V --version        Show version information
  -v --verbose        Higher verbosity
  -q --quiet          Lower verbosity
  -s --style=FILE     Style Specification
     --publish        Publish post
  -b --blogid=VALUE   Blog specific identifier (default=default)
     --postid=VALUE   Post to replace (if any)

Czyli aby stworzyć wpis należy użyć:

$ ./BlogLiterately http://greayer.wordpress.com/xmlrpc.php myuser mypass
    "Blogging Literately in Haskell" BlogLiterately.lhs

Świetny początek tego, co mi potrzebne. Obsługa błędów nie istnieje, po prostu trzymamy kciuki w nadzieji, że domyślne komunikaty o błędach będą wystarczająco jasne. Przydałoby się też wsparcie dla autorów i kategorii wpisów. Ale działa takie jak widać i jest narzędziem, które z powodzeniem użyłem do stworzenia niniejszego wpisu.

Przedstawione tutaj narzędzie można zainstalować poleceniem:

cabal install BlogLiterately

A na Hackage dostępna jest już nowsza wersja o ulepszonym działaniu.