diff options
Diffstat (limited to 'tools/website-blocker/main.hs')
-rw-r--r-- | tools/website-blocker/main.hs | 103 |
1 files changed, 0 insertions, 103 deletions
diff --git a/tools/website-blocker/main.hs b/tools/website-blocker/main.hs deleted file mode 100644 index 6c2b24472b11..000000000000 --- a/tools/website-blocker/main.hs +++ /dev/null @@ -1,103 +0,0 @@ -{-# LANGUAGE NamedFieldPuns #-} -module Main (main) where - --------------------------------------------------------------------------------- --- Dependencies --------------------------------------------------------------------------------- - -import qualified Data.Maybe as Maybe -import qualified Data.Time.Clock as Clock -import qualified Data.Time.Calendar as Calendar - --------------------------------------------------------------------------------- --- Types --------------------------------------------------------------------------------- - -newtype URL = URL { getURL :: String } deriving (Show) - -newtype IPAddress = IPAddress { getIPAddress :: String } deriving (Show) - -newtype Domain = Domain { getDomain :: String } deriving (Show) - -newtype Hour = Hour { getHour :: Integer } - -newtype Minute = Minute { getMinute :: Integer } - -data EtcHostEntry = EtcHostEntry { ip :: IPAddress - , domains :: [Domain] - } deriving (Show) - -data TimeRange = TimeRange { beg :: (Hour, Minute) - , end :: (Hour, Minute) - } - -data Allowance = Allowance { day :: Calendar.DayOfWeek - , timeslots :: [TimeRange] - } - -data Rule = Rule { urls :: [URL] - , allowed :: [Allowance] - } - --------------------------------------------------------------------------------- --- Functions --------------------------------------------------------------------------------- - -isToday :: Clock.UTCTime -> Calendar.DayOfWeek -> Bool -isToday date day = Calendar.dayOfWeek (Clock.utctDay date) == day - -isAllowed :: Clock.UTCTime -> [Allowance] -> Bool -isAllowed _ [] = False -isAllowed date xs = do - let rules = filter (isToday date . day) xs - case rules of - [day] -> True - [] -> False - -- Error when more than one rule per day - _ -> False - -serializeEntry :: EtcHostEntry -> String -serializeEntry EtcHostEntry{ip, domains} = - (getIPAddress ip) ++ "\t" ++ (unwords $ fmap getDomain domains) - -toEtcHostEntry :: Clock.UTCTime -> Rule -> Maybe EtcHostEntry -toEtcHostEntry date Rule{urls, allowed} = - if isAllowed date allowed then - Nothing - else - Just $ EtcHostEntry { ip = IPAddress "127.0.0.1" - , domains = fmap (Domain . getURL) urls - } - --- | Location of the rules.json file. -rulesFile :: FilePath -rulesFile = - "~/.config/website-blocker/rules.json" - --- | Reads and parses JSON from `rulesFile` and returns the result. -getRules :: IO [Rule] -getRules = pure $ - [ Rule { urls = [ URL "facebook.com" - , URL "twitter.com" - , URL "youtube.com" - , URL "instagram.com" - ] - , allowed = [] - } - , Rule { urls = [ URL "chat.googleplex.com" ] - , allowed = [ Allowance { day = Calendar.Saturday - , timeslots = [ TimeRange { beg = (Hour 0, Minute 0) - , end = (Hour 0, Minute 0) - } - ] - } - ] - } - ] - -main :: IO () -main = do - rules <- getRules - date <- Clock.getCurrentTime - let etcHosts = unlines . fmap serializeEntry . Maybe.catMaybes $ fmap (toEtcHostEntry date) rules - putStrLn etcHosts |