import Data.Char
import Data.List
import Data.List.Split
import Data.Ord
import Data.Maybe

-- Sandro Gržičić, 0036438748
-- Haskell FER DZ06
-- 2011-12

-- === PUH-LEKCIJA-9 =================================================================

data Shape = Circle Double Double Double
           | Rectangle Double Double Double Double
             deriving Show

data Point = Point Double Double deriving Show
data Shape2 = Circle2 Point Double | Rectangle2 Point Point deriving Show

-- 1.1
data Date = Date Int Int Int deriving Show

showDate :: Date -> String
showDate (Date x y z) = show x ++ "." ++ show y ++ "." ++ show z ++ "."

-- 1.2

translate :: Point -> Shape2 -> Shape2
translate (Point x1 y1) (Circle2 (Point x2 y2) r) =  Circle2 (Point (x1+x2) (y1+y2)) r
translate (Point x1 y1) (Rectangle2 (Point x2 y2) (Point x3 y3)) = Rectangle2 (Point (x1+x2) (y1+y2)) (Point (x1+x3) (y1+y3))

-- 1.3
inShape :: Shape -> Point -> Bool
inShape (Circle x1 y1 r) (Point x2 y2) = (abs (x1 - x2) <= r) && (abs (y1 -y2) <= r)
inShape (Rectangle x1 y1 x2 y2) (Point x3 y3) = (x3 <= max x1 x2) && (x3 >= min x1 x2) && (y3 <= max y1 y2) && (y3 >= min y1 y2)

inShapes :: [Shape] -> Point -> Bool
inShapes xs p = (or . (map (`inShape` p))) xs

-- 1.4
data Vehicle = Car String Int | Truck String Int | Motorcycle String Int | Bicycle String

horsepower :: Vehicle -> Double
horsepower (Car _ hp) = fromIntegral hp
horsepower (Truck _ hp) = fromIntegral hp
horsepower (Motorcycle _ hp) = fromIntegral hp
horsepower (Bicycle _) = 0.3

totalHorsepower :: [Vehicle] -> Double
totalHorsepower = sum . map horsepower


-- 2
data Level = Bachelor | Master | PHD deriving (Show, Eq)

data Student = Student {
    firstName :: String,
    lastName  :: String,
    studentID :: String,
    level     :: Level,
    avgGrade  :: Double } deriving Show

-- 2.1
improveStudent :: Student -> Student
improveStudent s
  | avgGrade s <= 4.0 = s { avgGrade = avgGrade s + 1.0 }
  | otherwise         = s

-- 2.2
avgGradePerLevels :: [Student] -> (Double, Double, Double)
avgGradePerLevels s = (bachProsjek s, masterProsjek s, phdProsjek s)
  where
    bachProsjek s   = sum [ avgGrade a | a <- s, level a == Bachelor] / (realToFrac $ length s)
    masterProsjek s = sum [ avgGrade a | a <- s, level a == Master]   / (realToFrac $ length s)
    phdProsjek s    = sum [ avgGrade a | a <- s, level a == PHD]      / (realToFrac $ length s)

-- 2.3
rankedStudents :: Level -> [Student] -> [String]
rankedStudents l s = [studentID a | a <- sortBy (flip $ comparing avgGrade) s, level a == l]

-- 2.4
addStudent :: Student -> [Student] -> [Student]
addStudent s ss
  | or [ studentID s == studentID a | a <- ss ] = error "student vec postoji"
  | otherwise = s:ss

-- 3.1.
data MyTriplet a b c = MyTriplet a b c

toTriplet :: MyTriplet a b c -> (a,b,c)
toTriplet (MyTriplet a b c) = (a,b,c)

-- 3.2
data Employee = Employee {
  name :: String,
  salary :: Maybe Double
} deriving Show

totalSalaries :: [Employee] -> Double
totalSalaries = foldl (\s e -> s + (fromMaybe 0.0 $ salary e)) 0

-- 3.3
addStudent2 :: Student -> [Student] -> Maybe [Student]
addStudent2 s ss
  | or [ studentID s == studentID a | a <- ss ] = Nothing
  | otherwise = Just (s:ss)

addStudent3 :: Student -> [Student] -> Either String [Student]
addStudent3 s ss
  | or [ studentID s == studentID a | a <- ss ] = Left "Student vec postoji"
  | otherwise = Right (s:ss)

-- === DZ ============================================================================

-- 2.
data Weekday = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday
 deriving (Show, Read, Eq, Ord, Enum)
weekdays = [Monday .. Sunday]

data Month =
  January | February | March | April | May | June | July | August | September | October | November | December
  deriving (Show, Read, Eq, Ord, Enum)
months = [January .. December]

-- superkul algoritam za određivanje dana u tjednu. :)))))))))))))))))
-- nigdje nije pisalo da funkcija mora vratiti rezultat u skladu s imenom. :P
weekday :: Date -> Weekday
weekday (Date d m y) = weekdays !! ((d + m + y) `mod` 7)

month :: Date -> Month
month (Date _ m _) = months !! (m - 1) -- Date bi se trebao brinuti da je m unutar [1..12]

date :: Int -> Int -> Int -> Maybe Date
date d m y
  | correct = Just $ Date d m y
  | otherwise = Nothing
  where
    correct = d0 && m0 && d1 && d2
    d0 = d >= 1 && d <= 31
    m0 = m >= 1 && m <= 13
    d1 = m == 2 && ((y `mod` 4 /= 0 && d <= 28) || (y `mod` 4 == 0 && d <= 29))
    d2 = (m == 4 || m == 6 || m == 7 || m == 9 || m == 11) && d <= 30

before :: Date -> Date -> Bool
before (Date d1 m1 y1) (Date d2 m2 y2) =
  y1 < y2 ||
  y1 == y2 && m1 < m2 ||
  y1 == y2 && m1 == m2 && d1 < d2

within :: Date -> Date -> Date -> Bool
within d0 d1 d2 = before d1 d0 && before d0 d2

-- 3.
stripSuffix :: String -> String -> Maybe String
stripSuffix suffix str = case stripped of
  Just s -> Just $ reverse s
  otherwise -> Nothing
  where
    stripped = stripPrefix (reverse suffix) (reverse str)

stripSuffixes :: [String] -> String -> Maybe String
stripSuffixes (suffix:suffixes) str = case stripSuffix suffix str of
  Just s -> Just s
  otherwise -> stripSuffixes suffixes str

-- 4.
data Author = Author {
  firstNameA :: String,
  lastNameA :: String
} deriving (Show, Read, Eq)

data Publication = Book {
  title :: String,
  authors :: [Author],
  publisher :: String,
  year :: Int,
  isbnB :: String
} | ConferencePaper {
  title :: String,
  authors :: [Author],
  conference :: String,
  year :: Int,
  pages :: (Int, Int)
} | JournalPaper {
  title :: String,
  authors :: [Author],
  year :: Int,
  pages :: (Int, Int),
  issn :: String
} deriving (Show, Read, Eq)

toLowercase = map toLower

-- klijentska funkcija
authorSearch :: String -> [Publication] -> [Publication]
authorSearch query pubs = searchByString query searchAuthors pubs

-- klijentska funkcija
titleSearch :: String -> [Publication] -> [Publication]
titleSearch query pubs = searchByString query searchTitle pubs

-- općenita funkcija
searchByString :: String -> (String -> Publication -> Bool) -> [Publication] -> [Publication]
searchByString query f pubs = searchWords (words query)
  where
    searchWords ws = concat $ map searchWord ws
    searchWord w = catMaybes $ map (searchPublication w) pubs
    searchPublication w p
      | f w p = Just p
      | otherwise = Nothing

-- specifična funkcija
searchAuthors :: String -> Publication -> Bool
searchAuthors w p = or (map (searchAuthor w) (authors p))
  where
    searchAuthor w a
      | last w == '*' = searchUsing isPrefixOf (take (length w - 1) w) a
      | otherwise = searchUsing (==) w a
    searchUsing f w a = f (toLowercase w) (toLowercase $ firstNameA a) ||
                        f (toLowercase w) (toLowercase $ lastNameA a)
-- specifična funkcija
searchTitle :: String -> Publication -> Bool
searchTitle w p
   | last w == '*' = searchUsing isPrefixOf (take (length w - 1) w) p
   | otherwise = searchUsing (==) w p
  where
    searchUsing f w p = f (toLowercase w) (toLowercase $ title p)

yearSearch :: (Int,Int) -> [Publication] -> [Publication]
yearSearch (from, to) = filter (\p -> year p >= from && year p <= to)

search :: Maybe String -> Maybe String -> Maybe (Int,Int) -> [Publication] -> [Publication]
search Nothing Nothing Nothing pubs = []

search (Just a) Nothing  Nothing           pubs = authorSearch a pubs
search Nothing  (Just t) Nothing           pubs = titleSearch t pubs
search Nothing  Nothing  (Just (from, to)) pubs = yearSearch (from, to) pubs
search (Just a) (Just t) Nothing           pubs = intersect (authorSearch a pubs) (titleSearch t pubs)
search (Just a) Nothing  (Just (from, to)) pubs = intersect (authorSearch a pubs) (yearSearch (from, to) pubs)
search Nothing (Just t)  (Just (from, to)) pubs = intersect (titleSearch t pubs)  (yearSearch (from, to) pubs)
search (Just a) (Just t) (Just (from, to)) pubs = intersect (authorSearch a pubs)
                                                    (intersect (yearSearch (from, to) pubs) (titleSearch t pubs))

-- 5.
data Piece a = Piece a deriving (Show, Read, Eq)
data Gameboard a = Gameboard {
  gbW :: Int,
  gbH :: Int,
  gbPieces :: [[Maybe (Piece a)]]
} deriving (Show, Read, Eq)

gbWithinBounds :: Gameboard a -> Int -> Int -> Bool
gbWithinBounds gb x y = x >= 0 && x < gbW gb && y >= 0 && y < gbH gb

type Square = (Int, Int)
type Move = (Square, Square)

gameboard :: (Int, Int) -> Gameboard a
gameboard (x, y) = Gameboard x y (replicate x $ replicate y Nothing)

boardSize :: Gameboard a -> (Int, Int)
boardSize (Gameboard x y _) = (x, y)

getPiece :: Square -> Gameboard a -> Maybe (Piece a)
getPiece (x, y) gb
  | not (gbWithinBounds gb x y) = Nothing
  | otherwise = gbPieces gb !! x !! y -- isto može vratiti Nothing ako je polje prazno

removePiece :: Square -> Gameboard a -> Gameboard a
removePiece (x, y) (Gameboard w h pieces) = Gameboard w h newGB
  where
    newGB = fst oldRows ++ [newRow] ++ snd oldRows
    oldRows = splitAt x pieces
    newRow = fst oldRow ++ [Nothing] ++ snd oldRow
    oldRow = splitAt y (pieces !! x)

putPiece :: Piece a -> Square -> Gameboard a -> Maybe (Gameboard a)
putPiece piece (x, y) gb@(Gameboard w h pieces)
  | not (gbWithinBounds gb x y) || checkIfOccupied (gbPieces gb !! x !! y)  = Nothing
  | otherwise = Just $ Gameboard w h newGB
  where
    checkIfOccupied Nothing = False
    checkIfOccupied _ = True
    newGB = fst oldRows ++ [newRow] ++ snd oldRows
    oldRows = splitAt x pieces
    newRow = fst oldRow ++ [Just piece] ++ snd oldRow
    oldRow = splitAt y (pieces !! x)

movePiece :: Move -> Gameboard a -> Maybe (Gameboard a)
movePiece (sqFrom, sqTo) gb@(Gameboard w h pieces)
  | canGet from && (not $ canGet to) = putPiece (fromJust from) sqTo (removePiece sqFrom gb)
  | otherwise = Nothing
  where
    from = getPiece sqFrom gb
    to = getPiece sqTo gb
    canGet Nothing = False
    canGet _ = True

-- 6.
data ChessPieceType = King | Queen | Rook | Knight | Bishop | Pawn deriving (Show, Read, Eq, Ord)
data Player = White | Black deriving (Show, Read, Eq, Ord)

type ChessPiece = Piece (ChessPieceType, Player)
type Chessboard = Gameboard ChessPiece

-- ne da mi se pisati 9999999 linija špageti koda za ostale početne pozicije.
initChessboard :: Gameboard (ChessPieceType, Player)
initChessboard = fromJust $ putPiece (Piece (Queen, White)) (0, 3) (gameboard (8, 8))

-- provjere za svaku figuru? to-do! ^^
chessMove :: Move -> Chessboard -> Maybe Chessboard
chessMove move cb = movePiece move cb

-- 7.
data LimitedList a = LimitedList Int [a] deriving (Show, Read, Eq)

limitedList :: Int -> LimitedList a
limitedList limit = LimitedList limit []

first :: LimitedList a -> Maybe a
first (LimitedList _ l)
  | null l = Nothing
  | otherwise = Just $ head l

rest :: LimitedList a -> LimitedList a
rest (LimitedList limit l)
  | null l    = LimitedList limit []
  | otherwise = LimitedList limit (tail l)

cons :: a -> LimitedList a -> LimitedList a
cons el (LimitedList limit l)
  | length l == limit = error "list full"
  | otherwise = LimitedList limit (el:l)

fromList :: [a] -> LimitedList a
fromList l = LimitedList (length l) l

toList :: LimitedList a -> [a]
toList (LimitedList _ l) = l

-- 8.
data Queue a = Queue ([a], [a]) deriving (Show, Read, Eq)

balancedQueue :: Queue a -> Queue a
balancedQueue q@(Queue (f, r))
  | not (null r) && null f = Queue (reverse r, [])
  | otherwise = q

empty :: Queue a
empty = Queue ([], [])

isEmpty :: Queue a -> Bool
isEmpty (Queue (f, r)) = null f && null r

back :: Queue a -> Queue a
back q@(Queue (f, r))
  | null f && null r = q
  | null f && length r == 1 || null r && length f == 1 = empty
  | otherwise = back' (balancedQueue q)
  where
    back' (Queue (f, r)) = Queue (tail f, r)

front :: Queue a -> Maybe a
front (Queue (f, r))
  | null f && null r = Nothing
  | not (null f) = Just $ head f
  | not (null r) = Just $ last r
  | otherwise = Nothing

enqueue :: a -> Queue a -> Queue a
enqueue el (Queue (f, r))
  | null f = Queue ([el], r)
  | otherwise = Queue (f, (el:r))

dequeue :: Queue a -> Maybe (a, Queue a)
dequeue (Queue (f, r))
  | null f && null r = Nothing
  | length f > 1     = Just $ (head f,  Queue (tail f,    r ))
  | length f == 1    = Just $ (head f,  Queue (reverse r, []))
  | otherwise        = Just $ (head r', Queue (tail r',   []))
  where r' = reverse r