aliens.hs

import Control.Monad

data AlienSymbol = (:@:) | (:#:) | (:!:) | (:^:) | (:%:) | (:*:) | (:&:) deriving (Ord, Eq, Enum)

data AlienNumber = AN [AlienSymbol] deriving (Ord, Eq)

trim n = let dropped = dropWhile (==(:@:)) n in
            case dropped of
                [] -> [(:@:)]
                _  -> dropped

instance Show AlienNumber where
    show (AN xs) = join $ map show $ trim $ reverse xs

instance Read AlienNumber where
    readsPrec _ ns = [(AN $ reverse $ map (\x -> read [x] :: AlienSymbol) ns, "")]

instance Read AlienSymbol where
    readsPrec _ n = let f = (:[]) . (flip (,) $ "") in
                        case n of
                            "@" -> f (:@:)
                            "#" -> f (:#:)
                            "!" -> f (:!:)
                            "^" -> f (:^:)
                            "%" -> f (:%:)
                            "*" -> f (:*:)
                            "&" -> f (:&:)


instance Show AlienSymbol where
    show (:@:) = "@"
    show (:#:) = "#"
    show (:!:) = "!"
    show (:^:) = "^"
    show (:%:) = "%"
    show (:*:) = "*"
    show (:&:) = "&"
    
ansucc ((:&:):[]) = (:@:) : (:#:) : []
ansucc (x:[]) = (succ x) : []
ansucc ((:&:):xs) = (:@:) : (ansucc xs)
ansucc (x:xs) = (succ x) : xs

anpred ((:@:):[]) = []
anpred ((:@:):xs) = (:&:) : (anpred xs)
anpred (x:[]) = (pred x) : []
anpred (x:xs) = (pred x) : xs

instance Enum AlienNumber where
    succ (AN xs) = AN $ ansucc xs
    pred (AN xs) = AN $ anpred xs
    toEnum n = acount n
    fromEnum = fromAlien
    
zero = AN [(:@:)]
one = AN [(:#:)]

aplus a (AN b) = 
    case zero == (AN $ trim b) of
        True -> a
        _    -> aplus (succ a) (pred $ AN b)

aminus a (AN b) = 
    case zero == (AN $ trim b) of
        True -> a
        _    -> aminus (pred a) (pred $ AN b)

amult a (AN b) = 
    case zero == (AN $ trim b) of
        True -> AN [(:@:)]
        _    -> aplus a (amult a $ pred $ AN b)

acount' 0 a = a
acount' n a = acount' (pred n) (succ a)
acount n = acount' n zero

fromAlien (AN n) = 
    case zero == (AN $ trim n) of
        True -> 0
        _    -> 1 + (fromAlien $ pred $ AN n)

instance Num AlienNumber where
    (+) a b = aplus a b
    (-) a b = aminus a b
    (*) a b = amult a b
    abs = undefined
    signum = undefined
    fromInteger n = acount n

fact = foldr1 (*) . enumFromTo one

main = do
        let foo = read "^@" :: AlienNumber
        let bar = read "&" :: AlienNumber
        print $ ((fromInteger 7) :: AlienNumber)
        print $ bar * foo + ((fromInteger 3) :: AlienNumber)
        print $ bar + bar + bar
        print $ bar - one - one
        print $ enumFromTo zero (bar*foo)
        print $ fact bar
        print $ fromEnum $ ((fromInteger 567) :: AlienNumber) - (one + bar)