```module Huffman where

import System( getArgs )

import Data.Char
import Iso
import Games
import BasicGames

type Set a = [a]

-- A simple priority queue, with integers corresponding
-- to frequencies; element with smallest frequency first
type PQ a = [(Int,a)]

-- Add a *new* item to a priority queue
addItem :: Int -> a -> PQ a -> PQ a
addItem n x [] = [(n,x)]
| n < n1 = (n,x) : q
| otherwise = (n1,x1) : addItem n x qrest

-- Update the frequency of an existing item in a priority queue
updPQ :: Eq a => PQ a -> a -> PQ a
updPQ ((n,x):rest) y
| y == x    = addItem (n+1) x rest
| otherwise = (n,x) : updPQ rest y

-- A game for Huffman
huff :: Eq a => PQ (Set a, Game a) -> Game a
huff [(_,(_,g))] = g
huff ((w1,(s1,g1)):(w2,(s2,g2)):wgs)
= huff \$ addItem (w1+w2) (s1++s2, Split (splitIso (\n -> elem n s1)) g1 g2) wgs

huffGame :: Eq a => PQ a -> Game a
huffGame pq = huff \$ map (\(i,x) -> (i,([x], constGame x))) pq

charHuffGame :: Game Char
charHuffGame =  huffGame \$ uniform ascii_chars

ascii_chars = map chr [32..126]
uniform = map (\x -> (1,x))

-- Static precomputed Huffman game
sHuffGame :: PQ Char -> Game [Char]
sHuffGame pq = listGame \$ huffGame pq

-- Dynamic Huffman game
dHuffGame :: PQ Char -> Game [Char]
dHuffGame pq = Split listIso unitGame \$
depGame (huffGame pq) (dHuffGame . updPQ pq)

-- Let's save some more bits
vecHuffGame :: Nat -> PQ Char -> Game [Char]
vecHuffGame 0 pq     = constGame []
vecHuffGame (n+1) pq = depGame (huffGame pq) (vecHuffGame n . updPQ pq) +> nonemptyIso

lengthHuffGame :: PQ Char -> Game (Nat,[Char])
lengthHuffGame pq = depGame binNatGame (\n -> vecHuffGame n pq)

dHuffGame' pq = lengthHuffGame pq +> Iso h j
where h :: [t] -> (Nat,[t])
h lst = (length lst, lst)
j :: (Nat,[t]) -> [t]
-- Precondition: n = length lst
j (n,lst) = lst

prodPQ :: PQ a -> PQ b -> PQ (a,b)
prodPQ p q = [ (m*n,(a,b)) | (m,a) <- p, (n,b) <- q ]
```