Line counter: monadic lifting issue

CountChanges.hs

import Data.Time.Calendar (diffDays)
import Data.Time.LocalTime
    ( getZonedTime
    , zonedTimeToLocalTime
    , ZonedTime(..)
    , LocalTime(..)
    , TimeOfDay(..))
import System.Process (readProcess)

data Comparison = Comparison {
    changeSet :: ChangeSet
  , startingCount :: Int
  , endingCount :: Int
}

data ChangeSet = ChangeSet {
    before :: String
  , after :: String
  , period :: Period
} deriving Show

data Period = Period {
    start :: ZonedTime
  , end :: ZonedTime
} deriving Show

main :: IO ()
main = showChange "test.txt"

showChange :: FilePath -> IO ()
showChange filepath =
    print . comparison lineCount =<< changes filepath "master" =<< today

today :: IO Period
today = do
    now <- getZonedTime
    beginningOfDay <- getBeginningOfDay now
    return $ Period beginningOfDay now

comparison :: (String -> Int) -> ChangeSet -> Comparison
comparison f changeset =
    Comparison changeset startingCount endingCount
    where
        startingCount = f $ before changeset
        endingCount = f $ after changeset

instance Show Comparison where
    show comparison =
        (show $ diff comparison) ++ " (" ++ (show $ perDay comparison) ++ "/day)"

diff :: Comparison -> Int
diff comparison = (endingCount comparison) - (startingCount comparison)

perDay :: Comparison -> Double
perDay comparison =
    (fromIntegral $ diff comparison) / (fromIntegral $ durationInDays $ period $ changeSet comparison)

durationInDays :: Period -> Int
durationInDays period = (+1) $ fromInteger $ diffDays endDays startDays
    where
        startDays = day $ start period
        endDays = day $ start period
        day = localDay . zonedTimeToLocalTime

lineCount :: String -> Int
lineCount = length . lines

changes :: FilePath -> String -> Period -> IO ChangeSet
changes filepath ref period@(Period start end) = do
    startingContent <- getRefContentsAt filepath ref start
    endingContent <- getRefContentsAt filepath ref end
    return $ ChangeSet startingContent endingContent period

getRefContentsAt :: FilePath -> String -> ZonedTime -> IO String
getRefContentsAt filepath ref time = getRefContents $ refAt filepath ref time

getRefContents :: String -> IO String
getRefContents ref = readProcess "git" ["show", ref] ""

refAt :: FilePath -> String -> ZonedTime -> String
refAt filepath ref time =
    ref ++ "@{" ++ (show time) ++ "}:" ++ filepath

getBeginningOfDay :: ZonedTime -> IO ZonedTime
getBeginningOfDay zonedTime =
    return $ zonedTime {
        zonedTimeToLocalTime = (zonedTimeToLocalTime zonedTime) {
            localTimeOfDay = midnight
        }
    }
    where midnight = TimeOfDay 0 0 0

Moving Period into IO is certainly the most direct route, but I've been trying to keep functions pure whenever possible, and this is the first time I've been stumped on doing so. I'll take a look at restructuring the return values of those functions.