Skip to content

Instantly share code, notes, and snippets.

@shegeley
Created April 28, 2019 15:02
Show Gist options
  • Save shegeley/545b27db47cb7d246bbcb730a824455f to your computer and use it in GitHub Desktop.
Save shegeley/545b27db47cb7d246bbcb730a824455f to your computer and use it in GitHub Desktop.
Nofap daemon in Haskell prototype
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment