Nofap daemon in Haskell prototype

nofap.hs

module App where

    import Data.List.Split
    import Data.Maybe
    import Control.Monad
    import Data.Time
    import qualified System.Directory as SD

    data Event = ChangeUserData User | Masturbated ZonedTime | WatchedPorn ZonedTime | ExportAppData | None deriving (Show, Read)

    exportFile :: String
    exportFile = "app.csv"

    data Sex = Male | Female deriving (Eq, Show, Read)

    data User = User{
        birthday :: Maybe Day,
        sex :: Maybe Sex
    } deriving (Eq, Show, Read)
    
    data App = App {
        user :: User,
        masturbations :: [ZonedTime],
        pornviews :: [ZonedTime],
        isImported :: Bool
    } deriving (Show)

    updateApp :: App -> Event -> App
    updateApp app None = app
    updateApp app (ChangeUserData u) = app {user = u}
    updateApp app (Masturbated t) = app {masturbations = t:(masturbations app)}
    updateApp app (WatchedPorn t) = app {pornviews = t:(pornviews app)}
    updateApp app (ExportAppData) = app

    updateUI :: App -> IO [Event]
    updateUI app = do
        putStrLn "\nPrint 'v' to show data, 'e' - edit user data, 'p' if you just watched porn, 'm' if you just masturbated and 'pm' if you just watched porn and masturbated"
        l <- getLine
        case l of
            "export" -> exportAppData app >> return [ExportAppData]
            "v" ->
                case masturbations app of 
                    [] -> putStr "Nothing found" >> return [None]
                    _ -> putStrLn "Masturbations:" >> mapM putStr (map (\x -> "\n-"++show x ) $ masturbations app) >> putStrLn "\n\nPornviews:" >> mapM putStr (map (\x -> "\n-"++show x ) $ pornviews app) >> return [None]
            "p" -> getZonedTime >>= \t -> return [WatchedPorn t]
            "m" -> getZonedTime >>= \t -> return [Masturbated t]
            "pm" -> getZonedTime >>= \t -> return [WatchedPorn t, Masturbated t]
            "s" -> exportAppData app >> return [ExportAppData]
            _ -> putStrLn "Input can't be interpreted" >> return [None]
    
    prepareToCSVExport :: [String] -> [String] -> String
    prepareToCSVExport xs ys 
        | length xs < length ys = prepareToCSVExport ("":xs) ys
        | length xs > length ys = prepareToCSVExport xs ("":ys)
        | otherwise = unlines $ map (\(x, y) -> x ++ "," ++ y) $ zip xs ys

    exportAppData :: App -> IO ()
    exportAppData app = writeFile exportFile $ prepareToCSVExport (map show $ masturbations app) (map show $ pornviews app)

    importAppData :: IO App
    importAppData = do
        existence <- SD.doesFileExist exportFile
        if existence == True
            then do
                contents <- readFile exportFile 
                return $ importData contents
            else return $ App {user = User Nothing Nothing, masturbations = [], pornviews = [], isImported = False}

    run :: App -> [Event] -> IO ()
    run app [] = do
        events <- updateUI app
        run app events
    run app (e:events) = do
        run (updateApp app e) events

    main :: IO ()
    main = do
        x <- importAppData
        run x []

    changeUserSex :: User -> IO User
    changeUserSex u = do
        putStrLn "Enter your sex (Male | Female)" >> getLine >>= \s -> 
            case reads s of
                [(Male, s)] -> return u {sex = Just Male}
                [(Female, s)] -> return u {sex = Just Female}
                _ -> putStrLn "Sex didn't recognized" >> return (u {sex = Nothing})
    
    changeUserBirthday :: User -> IO User
    changeUserBirthday u = do
        putStrLn "Enter your birthday (yyyy-mm-dd)" >> getLine >>= \s -> 
            case reads s :: [(Day, String)]  of 
                [(d, s)] -> return u {birthday = Just d}
                _ -> putStrLn "Date didin't recognized" >> return (u {birthday = Nothing})    

    importData :: String -> App
    importData text = 
        App {user = (User {birthday = Nothing, sex = Nothing}), masturbations = ms, pornviews = pvs, isImported = True}
        where 
        d = map (splitOn ",") $ lines text
        ms = catMaybes $ map parseExportableTimeStamp $ map head d
        pvs = catMaybes $ map parseExportableTimeStamp $ map (head . tail) d

    parseExportableTimeStamp :: String -> Maybe ZonedTime
    parseExportableTimeStamp t =
        let parsed = reads t :: [(ZonedTime, String)]
        in 
            case parsed of 
                [(a, b)] -> Just a
                _ -> Nothing