{-# LANGUAGE DeriveDataTypeable #-}

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
---- |
---- Module			: Fuzzytime
---- Copyright		: (C) Kamil Stachowski <kamil.stachowski@gmail.com>
---- License		: GPL3+
---- Maintainer		: Kamil Stachowski <kamil.stachowski@gmail.com>
---- Stability		: unstable
---- Portability	: unportable
---- Tells the time in a more humane way (the \"ten past six\"-style).
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

module Main (
	-- * Description
	-- $description
	  main
	, FuzzyTime
	, FuzzyTimeConf
	, toFuzzyTime
	) where

import System.Console.CmdArgs
import System.Time


-- $description
-- A small utility to tell the current time in a more humane way (the \"ten past six\"-style).
--
-- The whole thing works like this: the current time is read and turned into CalendarTime. This is fuzzified (i.e. the precision is reduced) and at the same time changed into FuzzyTime. FuzzyTime holds the time as two Ints (hour and min), the target language, the desired clock (12 vs. 24) and an information on whether it is am or pm (needed for the 12-hour clock). Custom functions show FuzzyTime as the \"ten past six\"-style String.
--
-- Depends on N. Mitchell's System.Console.CmdArds 0.6.4-1
--
-- To add a new language, two things need to be done:
--
-- (1) The new language has to be added to checkFTConf, to the instance of Show FuzzyTime, and to the help message.
--
-- (2) An appropriate function has to be created to turn FuzzyTime -> String.


-- CHANGELOG
-- TODO
-- 		more languages
-- 		exit codes
-- 		styles
-- 0.4.1	2011.01.15
-- 		fixed nextFTHour
-- 0.4	2011.01.15
-- 		added --time (thanks Daniel Fischer and Brent Yorgey from beginners@haskell.org!)
-- 		added --style
-- 		added Danish (by M_ller with my modifications)
-- 		removed "południe" from pl
-- 		sorted out the representation of midnight and noon
-- 		added a man page
-- 0.3	2011.01.14
-- 		added midnight and noon
-- 		added checking cli options
-- 		fixed the "quarter past quarter" bug
-- 0.2	2011.01.12
-- 		added French and German
-- 		added 12 vs. 24-hour clock
-- 0.1	2010.12.05
-- 		initial release: two languages (en and pl), 1 < precision < 60
-- 		0.1.1	2010.12.06
-- 				added cabal


-- config ===============================================================================


-- | \[config] The default clock (12 vs. 24-hour).
confDefClock :: Int
confDefClock = 12

-- | \[config] The default language.
confDefLang :: String
confDefLang = "en"

-- | \[config] The default precision (should be in [1..60]).
confDefPrec :: Int
confDefPrec = 5

-- | \[config] The default style (see man).
confDefStyle :: Int
confDefStyle = 1

-- | \[config] The default time (current).
confSetCurrTime :: FuzzyTimeConf -> IO FuzzyTimeConf
confSetCurrTime ft = do
	now <- getClockTime
	return $ ft { time = take 5 . drop 11 $ show now }


-- main =================================================================================


-- | The main part. Only reads the command line args and the current time, fuzzifies and prints it.
main :: IO ()
main = do
	fullFTConf <- confSetCurrTime getFTConf		-- ^ required to avoid unsafePerformIO
	conf <- cmdArgs fullFTConf
	if (checkFTConf conf) /= "ok" then
		putStrLn $ checkFTConf conf
		else
		print $ toFuzzyTime conf


-- cl args ==============================================================================


-- | Four options can be set via the command line: clock (12 vs. 24), language, precision and time.
data FuzzyTimeConf = FuzzyTimeConf {
	  clock	:: Int
	, lang	:: String
	, prec	:: Int
	, time	:: String
	, style	:: Int
	} deriving (Show, Data, Typeable)


-- | Check that arguments given at cli are correct.
checkFTConf :: FuzzyTimeConf -> String
checkFTConf (FuzzyTimeConf clock lang prec time style)
	| not (clock `elem` [12, 24])	= "--clock must be either 12 or 24."
	| not (lang `elem` ["da", "de", "en", "fr", "pl"])	= "--lang must be de, en, fr or pl."
	| prec < 1 || prec > 60			= "--prec must be 1 < prec < 60."
	| not checkTimeOk				= "--time must be given as HH:MM, where HH is in [0..23] and MM is in [0..59]"
	| not (style `elem` [1, 2])		= "--style must be either 1 or 2 (see the man page)."
	| otherwise						= "ok"
	where
	checkTimeOk :: Bool
	checkTimeOk = ':' `elem` time && h `elem` [0..23] && m `elem` [0..59]
		where
		h = read $ takeWhile (/=':') time 
		m = read $ reverse . takeWhile (/=':') . reverse $ time


-- | Fill the config with the default values.
getFTConf :: FuzzyTimeConf
getFTConf = FuzzyTimeConf {
	  clock	= confDefClock	&= help "12 or 24-hour clock; default 12-hour."
	, lang	= confDefLang	&= help "Language (currently da, de, en, fr and pl); default en."
	, prec	= confDefPrec	&= help "Precision (1 < prec < 60 [minutes]); default 5."
	, time	= ""			&= help "Time to fuzzify as HH:MM; default current time."			-- ^ time is set via confSetCurrTime to avoid unsafePerformIO
	, style	= confDefStyle	&= help "How the time is told (seem the man page); default 1."
	}
	&= program "fuzzytime"
	&= summary "Tell the time in a more humane way, e.g. 10:52 -> ten to eleven.\nv0.4, 2011.01.15, kamil.stachowski@gmail.com, GPL3+"


-- FuzzyTime – main =====================================================================


-- | Data for fuzzified time. Only keeps hour, minutes (both as Ints), clock (12 vs. 24-hour), night (Bool) and language.
-- Can be created from CalendarTime with toFuzzyTime. The String output (the \"ten past six\"-style) is obtained through Show.
data FuzzyTime = FuzzyTime {
	  fzClock	:: Int
	, fzHour	:: Int
	, fzLang	:: String
	, fzMin		:: Int
	, fzNight	:: Bool
	, fzStyle	:: Int
	} deriving (Eq)

-- | This is where FuzzyTime Int Int String is turned into the time String.
-- It is assumed that by the time these functions are called, hour will be in [0..23] and min will be in [0..59].
instance Show FuzzyTime where
	show ft@(FuzzyTime _ _ lang _ _ _) = case lang of
		"da" -> showFuzzyTimeDa ft
		"de" -> showFuzzyTimeDe ft
		"en" -> showFuzzyTimeEn ft
		"fr" -> showFuzzyTimeFr ft
		"pl" -> showFuzzyTimePl ft
		otherwise -> "Language " ++ lang ++ " is not supported."


-- | Converts CalendarTime to FuzzyTime using the given precision. The language and clock are also set, so that Show knows how to display it.
toFuzzyTime :: FuzzyTimeConf -> FuzzyTime
toFuzzyTime (FuzzyTimeConf cClock cLang cPrec cTime cStyle) =
	FuzzyTime cClock fuzzdHour cLang (fuzzdMin min) (hour < 10 || hour > 22) cStyle
	where
	hour :: Int
	hour = read $ takeWhile (/=':') cTime
	min :: Int
	min = read $ reverse . takeWhile (/=':') . reverse $ cTime
	fuzzdHour :: Int
	fuzzdHour =
		if cClock==24 then
			if hour==0 then 24 else hour
			else
			if hour==12 then hour else hour `mod` 12
	fuzzdMin :: Int -> Int
	fuzzdMin m =
		let
			mf = fromIntegral m
			cf = fromIntegral cPrec
		in
			(round(mf/cf) * cPrec) `mod` 60

-- | Makes sure that midnight is always represented as 0 or 24, depending on the clock, and noon always as 12.
nextFTHour :: FuzzyTime -> Int
nextFTHour (FuzzyTime clock hour _ _ night _)
	| clock == 12 && hour == 11		= if night then 0 else 12
	| clock == 12 && hour == 12		= 1
	| clock == 24 && hour == 24		= 1
	| otherwise						= hour + 1
				

-- FuzzyTime – shows ====================================================================

-- Danish (by M_ller with my modifications) ---------------------------------------------


showFuzzyTimeDa :: FuzzyTime -> String
showFuzzyTimeDa ft@(FuzzyTime clock hour _ min night style)
	| min == 0	= getHour hour
	| min < 30	= getMin min ++ " over " ++ getHour hour
	| min == 30	= "halv " ++ getHour (nextFTHour ft)
	| min > 30	= getMin (60-min) ++ " i " ++ getHour (nextFTHour ft)
	| otherwise	= "Ups, det ser ud til den er " ++ show hour ++ ":" ++ show min ++ "."
	where
	getHour :: Int -> String
	getHour h
		| h `mod` 12 == 0	= if style==1 then
								if clock==12 then numeralDa 12 else numeralDa h
								else
								if night then
									"midnat"
									else
									if min `elem` [0, 30] then "aften" else numeralDa h
		| otherwise			= numeralDa h
	getMin :: Int -> String
	getMin m
		| m `elem` [15, 45]	= "kvart"
		| otherwise 		= numeralDa m


numeralDa :: Int -> String
numeralDa n
	| n < 20			= numeralDaHelper1 n
	| n `mod` 10 == 0	= numeralDaHelper10 (n `div` 10)
	| otherwise			= numeralDaHelper1 (n `mod` 10) ++ "og" ++ numeralDaHelper10 (n `div` 10)
	where
	numeralDaHelper1 :: Int -> String
	numeralDaHelper1 i = ["en", "to", "tre", "fire", "fem", "seks", "syv", "otte", "ni", "ti", "elleve", "tolv", "tretten", "fjorten", "femten", "seksten", "sytten", "atten", "nitten"] !! (i-1)
	numeralDaHelper10 :: Int -> String
	numeralDaHelper10 i = ["tyve", "tredive", "fyrre", "halvtreds"] !! (i-2)


-- English ------------------------------------------------------------------------------


showFuzzyTimeEn :: FuzzyTime -> String
showFuzzyTimeEn ft@(FuzzyTime clock hour _ min night style)
	| min == 0	= if (getHour hour) `elem` ["midnight", "noon"] then (getHour hour) else (getHour hour) ++ " o’clock"
	| min <= 30	= getMin min ++ " past " ++ getHour hour
	| min > 30	= getMin (60-min) ++ " to " ++ getHour (nextFTHour ft)
	| otherwise	= "Oops, it looks like it's " ++ show hour ++ ":" ++ show min ++ "."
	where
	getHour :: Int -> String
	getHour h
		| h `mod` 12 == 0	= if style==1 then
								if clock==12 then numeralEn 12 else numeralEn h
								else
								if night then "midnight" else "noon"
		| otherwise			= numeralEn h
	getMin :: Int -> String
	getMin m
		| m == 30			= "half"
		| m `elem` [15, 45]	= "quarter"
		| otherwise			= numeralEn m


numeralEn :: Int -> String
numeralEn n
	| n < 20			= numeralEnHelper1 n
	| n `mod` 10 == 0	= numeralEnHelper10 (n `div` 10)
	| otherwise			= numeralEnHelper10 (n `div` 10) ++ "-" ++ numeralEnHelper1 (n `mod` 10)
	where
	numeralEnHelper1 :: Int -> String
	numeralEnHelper1 i = ["one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen"] !! (i-1)
	numeralEnHelper10 :: Int -> String
	numeralEnHelper10 i = ["twenty", "thirty", "forty", "fifty"] !! (i-2)


-- German -------------------------------------------------------------------------------


showFuzzyTimeDe :: FuzzyTime -> String
showFuzzyTimeDe ft@(FuzzyTime clock hour _ min night style)
	| min == 0	= if (getHour hour) `elem` ["Mitternacht", "Mittag"] then (getHour hour) else (getHour hour) ++ " Uhr"
	| min < 30	= getMin min ++ " nach " ++ getHour hour
	| min == 30	= "halb " ++ getHour (nextFTHour ft)
	| min > 30	= getMin (60-min) ++ " vor " ++ getHour (nextFTHour ft)
	| otherwise	= "Oops, es sieht aus, dass es " ++ show hour ++ ":" ++ show min ++ " ist."
	where
	getHour :: Int -> String
	getHour h
		| h `mod` 12 == 0	= if style==1 then
								if clock==12 then numeralDe 12 else numeralDe h
								else
								if night then
									"Mitternacht"
									else
									if min `elem` [0, 30] then "Mittag" else numeralDe h
		| otherwise			= numeralDe h
	getMin :: Int -> String
	getMin m
		| m `elem` [15, 45]	= "Viertel"
		| otherwise			= numeralDe m


numeralDe :: Int -> String
numeralDe n
	| n < 20			= numeralDeHelper1 n
	| n `mod` 10 == 0	= numeralDeHelper10 (n `div` 10)
	| otherwise			= numeralDeHelper1 (n `mod` 10) ++ "und" ++ numeralDeHelper10 (n `div` 10)
	where
	numeralDeHelper1 :: Int -> String
	numeralDeHelper1 i = ["null", "ein", "zwei", "drei", "vier", "fünf", "sechs", "sieben", "acht", "neun", "zehn", "elf", "zwőlf", "dreizehn", "vierzehn", "fünfzehn", "sechzehn", "siebzehn", "achtzehn", "neunzehn"] !! i
	numeralDeHelper10 :: Int -> String
	numeralDeHelper10 i = ["zwanzig", "dreissig", "vierzig", "fünfzig"] !! (i-2)


-- French -------------------------------------------------------------------------------


showFuzzyTimeFr :: FuzzyTime -> String
showFuzzyTimeFr ft@(FuzzyTime clock hour _ min night style)
	| min == 0	= getHour hour
	| min <= 30	= getHour hour ++ " " ++ getMin min
	| min > 30	= getHour (nextFTHour ft) ++ " moins " ++ getMin (60-min)
	| otherwise	= "Oops, il semble qu’il est " ++ show hour ++ ":" ++ show min ++ "."
	where
	getHour :: Int -> String
	getHour h
		| h `mod` 12 == 0	= if style==1 then
								(if clock==12 then numeralFr 12 else numeralFr h) ++ getHourWord h
								else
								if night then "minuit" else "midi"
		| otherwise			= numeralFr h ++ getHourWord h
	getHourWord :: Int -> String
	getHourWord h = if h==1 then " heure" else " heures"
	getMin :: Int -> String
	getMin m
		| min == 15			= "et quart"
		| min == 30			= "et demie"
		| min == 45			= "le quart"
		| otherwise			= numeralFr m


numeralFr :: Int -> String
numeralFr n
	| n < 20			= numeralFrHelper1 n
	| n `mod` 10 == 0	= numeralFrHelper10 (n `div` 10)
	| otherwise			= numeralFrHelper10 (n `div` 10) ++ "-" ++ numeralFrHelper1 (n `mod` 10)
	where
	numeralFrHelper1 :: Int -> String
	numeralFrHelper1 i = ["douze", "une", "deux", "trois", "quatre", "cinq", "six", "sept", "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix-sept", "dix-huit", "dix-neuf"] !! i
	numeralFrHelper10 :: Int -> String
	numeralFrHelper10 i = ["vingt", "trente", "quarante", "cinquante"] !! (i-2)


-- Polish ------------------------------------------------------------------------------


showFuzzyTimePl :: FuzzyTime -> String
showFuzzyTimePl ft@(FuzzyTime clock hour _ min night style)
	| min == 0	= getHourEven hour
	| min < 30	= getMin min ++ " po " ++ getHourOdd hour
	| min == 30	= "wpół do " ++ getHourOdd (nextFTHour ft)
	| min > 30	= "za " ++ getMin (60-min) ++ " " ++ getHourEven (nextFTHour ft)
	| otherwise	= "Oops, wychodzi, że jest " ++ show hour ++ ":" ++ show min ++ "."
	where
	getHourEven :: Int -> String
	getHourEven h
		| h `mod` 12 == 0	= if style==1 then
								if clock==12 then numeralPlOrdNom 12 else numeralPlOrdNom h
								else
								if night then "północ" else numeralPlOrdNom h
		| otherwise			= numeralPlOrdNom h
	getHourOdd :: Int -> String
	getHourOdd h
		| h `mod` 12 == 0	= if style==1 then
								if clock==12 then numeralPlOrdPraep 12 else numeralPlOrdPraep h
								else
								if night && min < 30 then "północy" else numeralPlOrdPraep h
		| otherwise			= numeralPlOrdPraep h
	getMin :: Int -> String
	getMin m
		| m `elem` [15, 45]	= "kwadrans"
		| otherwise			= numeralPlCard m


numeralPlCard :: Int -> String
numeralPlCard n
	| n < 20			= numeralPlCardHelper1 n
	| n `mod` 10 == 0	= numeralPlCardHelper10 (n `div` 10)
	| otherwise			= numeralPlCardHelper10 (n `div` 10) ++ " " ++ numeralPlCardHelper1 (n `mod` 10)
	where
	numeralPlCardHelper1 :: Int -> String
	numeralPlCardHelper1 i = ["jeden", "dwa", "trzy", "cztery", "pięć", "sześć", "siedem", "osiem", "dziewięć", "dziesięć", "jedenaście", "dwanaście", "trzynaście", "czternaście", "kwadrans", "szesnaście", "siedemnaście", "osiemnaście", "dziewiętnaście"] !! (i-1)
	numeralPlCardHelper10 :: Int -> String
	numeralPlCardHelper10 i = ["dwadzieścia", "trzydzieści", "czterdzieści", "pięćdziesiąt"] !! (i-2)

numeralPlOrdNom :: Int -> String
numeralPlOrdNom n
	| n <= 20			= numeralPlOrdNomHelper1 n
	| otherwise			= "dwudziesta " ++ numeralPlOrdNomHelper1 (n `mod` 10)
	where
	numeralPlOrdNomHelper1 :: Int -> String
	numeralPlOrdNomHelper1 n = ["dwunasta", "pierwsza", "druga", "trzecia", "czwarta", "piąta", "szósta", "siódma", "ósma", "dziewiąta", "dziesiąta", "jedenasta", "dwunasta", "trzynasta", "czternasta", "piętnasta", "szesnasta", "siedemnasta", "osiemnasta", "dziewiętnasta", "dwudziesta"] !! n

numeralPlOrdPraep :: Int -> String
numeralPlOrdPraep n
	| n <= 20			= numeralPlOrdPraepHelper1 n
	| otherwise			= "dwudziestej " ++ numeralPlOrdPraepHelper1 (n `mod` 10)
	where
	numeralPlOrdPraepHelper1 :: Int -> String
	numeralPlOrdPraepHelper1 n = ["dwunastej","pierwszej", "drugiej", "trzeciej", "czwartej", "piątej", "szóstej", "siódmej", "ósmej", "dziewiątej", "dziesiątej", "jedenastej", "dwunastej", "trzynastej", "czternastej", "piętnastej", "szesnastej", "siedemnastej", "osiemnastej", "dziewiętnastej", "dwudziestej"] !! n