Roconnor's CarDecode.hs

module CarDecode where

import Numeric
import Data.Char
import Control.Monad.State
import Control.Monad
import Data.List

type Car = [Chamber]

data Chamber = Chamber [Int] Bool [Int] deriving Show

countTanks x = maximum (concatMap (\(Chamber t _ b) -> t++b) x) + 1

countMains x = length $ filter (\(Chamber _ m _) -> not m) x

class Decode a where
  decode :: String -> (a,String)
  encode :: a -> String

instance Decode Integer where
  decode = decodeNat
  encode = encodeNat

instance (Decode a) => Decode [a] where
  decode = decodeList
  encode = encodeList

instance Decode Chamber where
  decode = decodeChamber
  encode = error "TODO: encodeChamber"

decodeTrinary x = let [(y,"")] = readInt 3 (`elem` "012") digitToInt x in y

decodeNat :: String -> (Integer,String)
decodeNat ('0':x)     = (0,x)
decodeNat ('1':x)     = (fromIntegral (digitToInt (head x))+1,tail x)
decodeNat ('2':'2':x) = (decodeTrinary encode+(3^places2-1)`div`2,y)
  where
        (places,x0) = decodeNat x
        places2 = places+2
        (encode,y) = genericSplitAt places2 x0

decodeBool x | n == 0 = (False,y)
             | n == 1 = (True,y)
  where
        (n,y) = decodeNat x

decodeList ('0':x) = ([],x)
decodeList ('1':x) = ([n],y)
  where
        (n,y) = decode x
decodeList ('2':'2':x) = (runState . replicateM (fromInteger (len+2)) $ State decode) y
  where
        (len,y) = decodeNat x

decodeChamber x = (Chamber (map fromInteger c1) b (map fromInteger c2),x3)
  where
        (c1,x1) = decodeList x
        (b,x2) = decodeBool x1
        (c2,x3) = decodeList x2

decodeCar :: String -> Car
decodeCar x = let (y,"") = decode x in y


encodeNat :: Integer -> String
encodeNat 0 = "0"
encodeNat x | x < 4 = "1"++(show (x-1))
            | otherwise = "22"++encodeNat (fromIntegral i-2)++replicate (i - length atBase) '0'++atBase
  where
   Just i' = findIndex (>x) [(3^n -1)`div`2 | n<-[0..]]
   (i,base) = (i'-1, (3^i-1)`div`2)
   atBase = showIntAtBase 3 ("012"!!) (x-base) ""

encodeList [] = "0"
encodeList [x] = "1"++encode x
encodeList l = "22"++encodeNat (fromIntegral (length l) - 2)++concatMap encode l

encodeFuel :: [[[Integer]]] -> String
encodeFuel = encode