-
Notifications
You must be signed in to change notification settings - Fork 0
/
SpopBarczTrzpil_IOUtils.hs
125 lines (107 loc) · 3.03 KB
/
SpopBarczTrzpil_IOUtils.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
{-# LANGUAGE DeriveDataTypeable, ExtendedDefaultRules, EmptyDataDecls #-}
module SpopBarczTrzpil_IOUtils where
import SpopBarczTrzpil_DataStructures
import System.IO
import System.IO.Error
import Data.Maybe
import Data.Char
import Data.Time.Clock
import Data.Time.Calendar
import Text.JSON
import Text.JSON.Generic
-- IO UTILITIES
parseCommandLine :: IO [String]
parseCommandLine = do
str <- getLine
tokens <- doSplit str
if length tokens > 0 then
return (tokens)
else
parseCommandLine
yesno :: String -> IO Bool
yesno prompt = do
putStr $ prompt ++ " y/n: "
hFlush stdout
str <- getLine
case str of
"y" -> return True
"n" -> return False
otherwise -> do
putStrLn "Invalid input."
yesno prompt
printCommands :: [String] -> IO ()
printCommands commands = do
putStrLn ("Available commands: " ++ (printableList commands))
return ()
-- print error and wait for ENTER
printError :: String -> IO ()
printError str = do
putStrLn $ "ERROR: " ++ str ++ " [press Enter to continue]"
getLine
return()
-- gets input, if input == "" returns default
getLineWithDefault :: String -> IO String
getLineWithDefault defaultString = do
newString <- getLine
if newString == "" then do
return defaultString
else do
return newString
-- get input, performing a Check (can be noCheck)
getValidString :: Check -> IO String
getValidString check = do
string <- getLine
if check string then do
return string
else do
putStrLn "Incorrect format. Try again: "
getValidString check
-- getLineWithDefault + Check
getValidStringWithDefault :: Check -> String -> IO String
getValidStringWithDefault check defaultString = do
string <- getLine
if string == "" then do
return defaultString
else do
if check string then do
return string
else do
putStrLn "Incorrect format. Try again or press Enter to use default: "
getValidStringWithDefault check defaultString
getCurrentDate :: IO (Integer,Int,Int) -- :: (year,month,day)
getCurrentDate = getCurrentTime >>= return . toGregorian . utctDay
printDate :: IO ()
printDate = do
today <- getCurrentDate
putStrLn $ "Today is: " ++ (formatDate today)
readDate :: IO (Integer, Int, Int)
readDate = do
date <- getLine
parseDate date
parseDate :: String -> IO (Integer, Int, Int)
parseDate date = do
let strings = delimSplit date '.'
if length strings /= 3 then do
printError "incorrect format (should be day.month.year)"
readDate
else do
if not (isInt (strings !! 0)) || not (isInt (strings !! 1)) || not (isInt (strings !! 2)) then do
printError "incorrect format (should be day.month.year)"
readDate
else do
let day = read (strings !! 0) :: Int
let month = read (strings !! 1) :: Int
let year = read (strings !! 2) :: Integer
let validDate = fromGregorianValid year month day
if isNothing validDate then do
printError "incorrect date"
readDate
else do
return (year, month, day)
readDateWithDefault :: (Integer, Int, Int) -> IO (Integer, Int, Int)
readDateWithDefault defaultDate = do
date <- getLine
if date == "" then do
return defaultDate
else do
parseDate date