{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
{-# OPTIONS_GHC -fwarn-missing-methods     #-}
{-# LANGUAGE DeriveDataTypeable            #-}
{-# LANGUAGE GeneralizedNewtypeDeriving    #-}

module Data.Numerals.Decimal where


import Data.Data
import Data.Digits
import Data.Typeable
import Test.QuickCheck
import Test.QuickCheck.Gen


data DecimalDigit = Zero | One | Two | Three | Four | Five | Six | Seven | Eight | Nine
                    deriving (Data, Enum, Eq, Ord, Typeable)

instance Show DecimalDigit where show = show . fromEnum

-- | Takes a DecimalDigit to its Integral form
decimal_digit_to_integral :: (Integral n) => DecimalDigit -> n
decimal_digit_to_integral digit = case digit of  
                                       Zero  -> 0
                                       One   -> 1
                                       Two   -> 2
                                       Three -> 3
                                       Four  -> 4
                                       Five  -> 5
                                       Six   -> 6
                                       Seven -> 7
                                       Eight -> 8
                                       Nine  -> 9
    
-- | Takes an Integral digit to a DecimalDigit.  This function is partial
--   on a set of Integrals.
unsafe_integral_digit_to_decimal_digit :: (Integral n) => n -> DecimalDigit
unsafe_integral_digit_to_decimal_digit integer = case integer of
                                                      0 -> Zero       
                                                      1 -> One        
                                                      2 -> Two        
                                                      3 -> Three      
                                                      4 -> Four       
                                                      5 -> Five       
                                                      6 -> Six        
                                                      7 -> Seven      
                                                      8 -> Eight      
                                                      9 -> Nine       
                                                    
                                   

integral_to_digits :: (Integral n) => n -> [DecimalDigit]
integral_to_digits =  (fmap unsafe_integral_digit_to_decimal_digit) . (digits 10)

digits_to_integral :: (Integral n) => [DecimalDigit] -> n
digits_to_integral = (unDigits 10) . (fmap decimal_digit_to_integral)



prop_decimal_digit_round_trip :: [DecimalDigit] -> Bool
prop_decimal_digit_round_trip d = (integral_to_digits . digits_to_integral $ d) == d

prop_positive_integral_round_trip :: Integral n => n -> Bool
prop_positive_integral_round_trip n = (digits_to_integral . integral_to_digits . abs $ n) == abs n