-- Copyright 2022 University of Freiburg
-- Janek Spaderna <janek.spaderna@pluto.uni-freiburg.de>
{-# LANGUAGE TemplateHaskell #-}

module Ex02 where

import Data.List
import Test.QuickCheck
import Tracks

------------------------------------------------------------------------------
-- Excercise 1 (List functions II—deduplication)

undup :: (Eq a) => [a] -> [a]
undup [] = []
undup (a : as) = a : undup (filter (a /=) as)

prop_undup_undup_is_undup :: [Integer] -> Bool
prop_undup_undup_is_undup xs = undup (undup xs) == undup xs

prop_dup_undup :: Integer -> Bool
prop_dup_undup n = undup ([1 .. n] ++ [1 .. n]) == undup [1 .. n]

------------------------------------------------------------------------------
-- Excercise 2 (Smallest factor)

smallestFactor1 :: Integer -> Integer
smallestFactor1 n = head $ filter isFactor [2 .. n]
  where
    isFactor k = n `mod` k == 0

smallestFactor2 :: Integer -> Integer
smallestFactor2 n =
  -- This list comprehension is equivalent to the `filter` above.
  head [k | k <- [2 .. n], n `mod` k == 0]

-- Student solution.
smallestFactor3 :: Integer -> Integer
smallestFactor3 = sF 2
  where
    sF k n = if n `mod` k == 0 then k else sF (k + 1) n

prop_smallestFactor12 :: Integer -> Property
prop_smallestFactor12 n = (n >= 2) ==> smallestFactor1 n === smallestFactor2 n

prop_smallestFactor23 :: Integer -> Property
prop_smallestFactor23 n = (n >= 2) ==> smallestFactor2 n === smallestFactor3 n

------------------------------------------------------------------------------
-- Excercise 3 (Media Library)

data Track = Track
  { trackId :: TrackId,
    trackName :: Title,
    trackArtist :: Artist,
    trackDuration :: Duration
  }
  deriving (Show, Eq)

data Album = Album
  { albumName :: Title,
    albumTracks :: [TrackId]
  }
  deriving (Show)

data Rating = Good | Bad
  deriving (Show, Eq)

type User = String

data UserRating = UserRating
  { urUser :: User,
    urTrack :: TrackId,
    urRating :: Rating
  }
  deriving (Show, Eq)

data MediaBib = MediaBib
  { bibTracks :: [Track],
    bibAlbums :: [Album],
    bibRatings :: [UserRating]
  }
  deriving (Show)

emptyMediaBib :: MediaBib
emptyMediaBib = MediaBib {bibTracks = [], bibAlbums = [], bibRatings = []}

addAlbum :: TrackId -> AlbumName -> MediaBib -> MediaBib
addAlbum tid album bib =
  bib
    { bibAlbums =
        getModifiedAlbum (bibAlbums bib)
          : filter notModifiedAlbum (bibAlbums bib)
    }
  where
    -- These two are equivalent.
    notModifiedAlbum = (album /=) . albumName
    _notModifiedAlbum a = album /= albumName a

    getModifiedAlbum :: [Album] -> Album
    getModifiedAlbum [] = Album {albumName = album, albumTracks = [tid]}
    getModifiedAlbum (a : as)
      | album == albumName a = a {albumTracks = tid : filter (/= tid) (albumTracks a)}
      | otherwise = getModifiedAlbum as

prop_addAlbum_two_tracks :: AlbumName -> TrackId -> TrackId -> Property
prop_addAlbum_two_tracks name t1 t2 =
  t1 /= t2 ==> length albums == 1 && albumTracks (head albums) == [t1, t2]
  where
    albums = bibAlbums (addAlbum t1 name (addAlbum t2 name emptyMediaBib))

prop_addAlbum_two_albums :: AlbumName -> AlbumName -> TrackId -> TrackId -> Property
prop_addAlbum_two_albums name1 name2 t1 t2 =
  name1 /= name2 ==> length albums == 2
  where
    albums = bibAlbums (addAlbum t1 name1 (addAlbum t2 name2 emptyMediaBib))

rateTrack :: User -> TrackId -> Rating -> MediaBib -> MediaBib
rateTrack user tid rating bib =
  bib
    { bibRatings =
        getModifiedRating (bibRatings bib)
          : filter unmodifiedRating (bibRatings bib)
    }
  where
    unmodifiedRating :: UserRating -> Bool
    unmodifiedRating ur = urUser ur /= user || urTrack ur /= tid

    getModifiedRating :: [UserRating] -> UserRating
    getModifiedRating [] = UserRating {urUser = user, urTrack = tid, urRating = rating}
    getModifiedRating (r : rs)
      | urUser r == user && urTrack r == tid = r {urRating = rating}
      | otherwise = getModifiedRating rs

prop_rateTrack_twice :: User -> TrackId -> Bool
prop_rateTrack_twice user tid =
  length (bibRatings (rateTrack user tid Bad (rateTrack user tid Good emptyMediaBib))) == 1

prop_rateTrack_twice_different :: User -> User -> TrackId -> TrackId -> Property
prop_rateTrack_twice_different u1 u2 t1 t2 =
  (u1 /= u2 || t1 /= t2) ==> length ratings == 2
  where
    ratings = bibRatings (rateTrack u1 t1 Bad (rateTrack u2 t2 Good emptyMediaBib))

buildBib :: TrackList -> MediaBib
buildBib [] = emptyMediaBib
buildBib ((tid, title, artist, duration, albumList) : ts) = addAlbums albumList tsBib'
  where
    tsBib = buildBib ts
    tsBib' = tsBib {bibTracks = newTrack : bibTracks tsBib}

    addAlbums :: [AlbumName] -> MediaBib -> MediaBib
    addAlbums [] bib = bib
    addAlbums (a : as) bib = addAlbums as (addAlbum tid a bib)

    newTrack =
      Track
        { trackId = tid,
          trackName = title,
          trackArtist = artist,
          trackDuration = duration
        }

prop_buildBib :: Bool
prop_buildBib = length (bibAlbums bib) == 5 && length (bibTracks bib) == 14
  where
    bib = buildBib allTracks

albumLengths :: MediaBib -> [(AlbumName, Duration)]
albumLengths bib = map albumDuration (bibAlbums bib)
  where
    albumDuration :: Album -> (AlbumName, Duration)
    albumDuration album =
      -- Return the albums name together with the sum of the contained
      -- durations.
      (albumName album, sum durations)
      where
        -- Lookup the duration of each track.
        durations = map lookupDuration (albumTracks album)

    lookupDuration :: TrackId -> Duration
    lookupDuration tid =
      -- Filter all known tracks down to the wanted track id.
      case filter ((tid ==) . trackId) (bibTracks bib) of
        -- The track id does not exist. Return duration=0.
        [] -> 0
        -- We found a track of matching track id. Return the duration of the
        -- first track, ignore the others.
        t : _ -> trackDuration t

goodAlbums :: User -> MediaBib -> [Album]
goodAlbums user bib = filter isGood (bibAlbums bib)
  where
    -- An album is good, if more than half of the contained songs are rated
    -- `Good`.
    isGood album = length goodAlbumTracks * 2 >= length allAlbumTracks
      where
        goodAlbumTracks = filter ratedGood allAlbumTracks
        allAlbumTracks = albumTracks album

    ratedGood :: TrackId -> Bool
    ratedGood tid =
      -- Check if the corresponding `UserRating` is an element in the list of ratings.
      goodRating `elem` bibRatings bib
      where
        -- We can have nested `where` clauses!
        goodRating = UserRating {urUser = user, urTrack = tid, urRating = Good}

------------------------------------------------------------------------------
-- Excercise 4 (Tic-Tac-Toe)

data Token = X | O | None
  deriving (Show, Eq, Bounded, Enum)

type TicTacToe = [[Token]]

-- | This function returns the winning token, `X` or `O`, if there is one, or
-- `None` otherwise.
--
-- It works for any size of `TicTacToe`, as long as it is square.
winner :: TicTacToe -> Token
winner ttt =
  anyRowWinner rows
    `orWinner` anyRowWinner columns
    `orWinner` rowWinner diagonal1
    `orWinner` rowWinner diagonal2
  where
    rows = ttt
    columns = transpose rows
    diagonal1 = diagonal rows
    diagonal2 = diagonal (reverse rows)

    -- Extract the diagonal running from the top left to the bottom right.
    diagonal :: TicTacToe -> [Token]
    diagonal = go 0
      where
        go _ [] = []
        -- Take the n-th element from row `r`, take the n+1 from the next row, etc.
        go n (r : rs) = r !! n : go (n + 1) rs

    -- A token has won a row if it is the only token appearing in that row.
    rowWinner :: [Token] -> Token
    rowWinner [] = None
    rowWinner (xo : rest)
      | all (xo ==) rest = xo
      | otherwise = None

    -- A token has won a list of rows if it has won any of the rows.
    anyRowWinner :: TicTacToe -> Token
    anyRowWinner [] = None
    anyRowWinner (r : rs) = rowWinner r `orWinner` anyRowWinner rs

    -- Combine two potentially winning tokens. If the first token has not won,
    -- return the second one.
    orWinner :: Token -> Token -> Token
    orWinner None xo = xo
    orWinner xo _ = xo

isWon :: TicTacToe -> Bool
isWon ttt = winner ttt /= None

isInProgress :: TicTacToe -> Bool
isInProgress cells =
  -- Check if any of the rows contains a `None` cell
  any (elem None) cells
    -- And there is no winner yet.
    && not (isWon cells)

isDraw :: TicTacToe -> Bool
isDraw cells =
  -- Check that no row contains a `None` cell
  not (any (elem None) cells)
    -- but there is no winner.
    && not (isWon cells)

prop_won_row :: Property
prop_won_row =
  -- For any ordering of the rows the winner should be X.
  forAll (shuffle rows) $ \ttt ->
    winner ttt === X
  where
    rows =
      [ [O, O, n],
        [X, X, X],
        [n, n, n]
      ]
    n = None

prop_won_col :: Property
prop_won_col =
  -- For any ordering of the columns the winner should be X.
  forAll (shuffle (transpose rows)) $ \columns ->
    winner (transpose columns) === X
  where
    rows =
      [ [O, X, n],
        [n, X, O],
        [n, X, n]
      ]
    n = None

prop_won_diagonal1 :: Property
prop_won_diagonal1 = winner ttt === X
  where
    ttt =
      [ [X, O, X],
        [n, X, n],
        [O, O, X]
      ]
    n = None

prop_won_diagonal2 :: Property
prop_won_diagonal2 = winner ttt === O
  where
    ttt =
      [ [n, X, O],
        [n, O, n],
        [O, X, X]
      ]
    n = None

------------------------------------------------------------------------------
-- Generate a function to check all properties.
--
-- Has to go at the very bottom of the file!

return []

checkAll :: IO Bool
checkAll = $quickCheckAll