timecalc-0.1: TimeCalc.hs

module Main where

import Text.ParserCombinators.UU
import Text.ParserCombinators.UU.Utils
import Text.ParserCombinators.UU.BasicInstances hiding (Parser, input)
import System.Console.Haskeline
import System.Environment (getArgs)

type Parser a = P (Str Char String LineColPos) a

main :: IO ()
main = do
  args <- getArgs
  if null args then interactive 
               else putStrLn $ run timeExpr (unwords args)

interactive :: IO ()
interactive = runInputT defaultSettings loop
  where 
   loop :: InputT IO ()
   loop = do minput <- getInputLine "> "
             case minput of
               Nothing -> return ()
               Just "quit" -> return ()
               Just input -> do outputStrLn $ run timeExpr input
                                loop


run :: Parser String -> String -> String
run p inp = do  let (a, errors) =  parse ( (,) <$> p <*> pEnd) (createStr (LineColPos 0 0 0) inp)
                if null errors then  a
                               else  "Error in expression"

timeExpr :: Parser String
timeExpr = format <$> expr
 where format :: Double -> String
       format x = let minutes :: Integer
                      seconds :: Integer
                      (minutes,secondsMultiplier) = properFraction x
                      seconds = round $ secondsMultiplier * 60
                      showSeconds s | s < 10    = "0" ++ show s
                                    | otherwise = show s
                  in  show minutes ++ ":" ++ showSeconds seconds

expr :: Parser Double
expr = foldr pChainl ( pDouble <|> pTime <|>pParens expr) (map same_prio operators) 
 where
  operators       = [[('+', (+)), ('-', (-))],  [('*' , (*))], [('/' , (/))]]
  same_prio  ops  = foldr (<|>) empty [ op <$ lexeme (pSym c) | (c, op) <- ops]

pTime :: Parser Double
pTime = lexeme pRawMinuteTime <|> lexeme pRawHourTime

pRawMinuteTime :: Parser Double
pRawMinuteTime = makeTime <$> pIntegerRaw <* pSym ':' <*> pIntegerRaw <?> "min:sec"
 where makeTime x y = x + (y / 60.0)

pRawHourTime :: Parser Double
pRawHourTime = makeTime <$> pIntegerRaw <* pSym ':' <*> pIntegerRaw <* pSym ':' <*> pIntegerRaw <?> "hour:min:sec"
 where makeTime x y z = x * 60 + y + z / 60.0