Happily picked up Haskell a couple days back and working on the following use case.
Given a list of JSON objects with date fields and a start date, I want to create a list of weeks (here a tuple of dates, but improvements are welcome) from the start date to today plus a week, and count the number of days from the JSON that fall within each week.
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
import Data.Aeson
import GHC.Generics
import Network.HTTP.Conduit (simpleHttp)
import Data.Text (Text, intercalate)
import Data.Time
import Data.Time.Clock.POSIX
import Data.Map (Map, fromList, toList, insert, lookup)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Internal as BSI
parseDate str = utctDay $ parseTimeOrError True defaultTimeLocale "%d/%m/%Y" str :: Day
type DateRange = (Day, Day)
type DateRangeCount = (DateRange, Int)
_makeRanges :: Day -> Day -> [DateRange] -> [DateRange]
_makeRanges currDate endDate ranges
| currDate <= endDate =
let endRangeDate = addDays 6 currDate
newCurrDate = addDays 1 endRangeDate
in (currDate, endRangeDate) : _makeRanges newCurrDate endDate ranges
| otherwise = ranges
createRanges :: String -> UTCTime -> [DateRange]
createRanges startDateString endTime =
let startDate = parseDate startDateString
endDate = utctDay endTime
in _makeRanges startDate endDate []
isDayInRange :: Day -> DateRange -> Bool
isDayInRange day range = day >= fst range && day <= snd range
findRange :: Day -> ([DateRange] -> [DateRange])
findRange day = filter $ isDayInRange day
incrementCount :: [DateRange] -> Map DateRange Int -> Person -> Map DateRange Int
incrementCount ranges countMap person =
let range = head $ findRange (date person) ranges
in case Data.Map.lookup range countMap of
Just i -> insert range (i+1) countMap
Nothing -> countMap
countPersons :: [Person] -> [DateRange] -> Map DateRange Int
countPersons persons ranges =
let countMap = fromList $ map (, 0) ranges
in foldl (incrementCount ranges) countMap persons
newtype Person =
Person {date :: Day} deriving (Show, Generic)
instance FromJSON Person where
parseJSON (Object o) = do
dateString <- o .: "date"
return Person {date = parseDate dateString}
getData :: Maybe String -> IO (Either String [Person])
getData url = case url of
Just url -> eitherDecode <$> simpleHttp url
Nothing -> return (eitherDecode <$> BSL.pack $ map BSI.c2w "[{\"date\":\"21/05/2021\"},{\"date\":\"01/06/2021\"}]")
main :: IO ()
main = do
-- r <- getData $ Just "gg"
r <- getData Nothing
case r of
Left err -> putStrLn err
Right persons -> do
endTime <- getCurrentTime
let ranges = createRanges "01/05/2021" endTime
counts = countPersons persons ranges
mapM_ print $ toList counts
print $ sum counts
Current input "01/05/2021", the output is:
((2021-05-01,2021-05-07),0)
((2021-05-08,2021-05-14),0)
((2021-05-15,2021-05-21),1)
((2021-05-22,2021-05-28),0)
((2021-05-29,2021-06-04),1)
((2021-06-05,2021-06-11),0)
2
Bonus question if it's allowed:
I also want to type Map DateRange Int
as DateRangeCountMap, but this messes with fromList's expected type which is the raw Map. Any ideas?