module HaskellExamMemorize where

import Data.Char (isDigit, isLetter, isLower, isUpper)

-- The shortest useful pack of patterns to memorize before the test.

-- Simple functions

hello :: String -> String
hello name = "Hello " ++ name ++ "!!!"

volume :: Num a => a -> a -> a -> a
volume x y z = x * y * z

doubleMe :: Num a => a -> a
doubleMe x = 2 * x

initial :: String -> String -> String
initial firstName lastName = take 1 firstName ++ "." ++ take 1 lastName ++ "."

sign :: (Ord a, Num a) => a -> a
sign x
  | x > 0 = 1
  | x < 0 = -1
  | otherwise = 0

signIf :: (Ord a, Num a) => a -> a
signIf x =
  if x > 0
    then 1
    else if x < 0 then -1 else 0

-- Lists, strings, filter, map

myNumbers :: [Int]
myNumbers = [11 .. 99]

doubledMyNumbers :: [Int]
doubledMyNumbers = map doubleMe myNumbers

mod13 :: Integral a => [a] -> [a]
mod13 = filter (\x -> x `mod` 13 == 0)

sumPositiveOnList :: [Int] -> Int
sumPositiveOnList xs = sum (filter (> 0) xs)

count :: Num p => (t -> Bool) -> [t] -> p
count p xs = fromIntegral (length (filter p xs))

onlyLowercase :: String -> String
onlyLowercase = filter isLower

onlyUppercase :: String -> String
onlyUppercase = filter isUpper

allNotDigits :: String -> String
allNotDigits = filter (not . isDigit)

charN :: Int -> String -> Char
charN n s = s !! (n - 1)

isPalindrome :: Eq a => [a] -> Bool
isPalindrome xs = xs == reverse xs

mergeLists :: [[a]] -> [a]
mergeLists = concat

howManyTimes :: (Num a, Eq t) => t -> [t] -> a
howManyTimes x xs = fromIntegral (length (filter (== x) xs))

connectOneAfterOne :: [a] -> [a] -> [a]
connectOneAfterOne (x : xs) (y : ys) = x : y : connectOneAfterOne xs ys
connectOneAfterOne _ _ = []

pair :: Num a => [a] -> [a] -> (a, a)
pair (x : _) ys@(_ : _) = (x, last ys)
pair _ _ = (0, 0)

-- List comprehension

listA :: [(String, String)]
listA =
  [ ("Anna", "Lis")
  , ("Marek", "Nowak")
  , ("Ola", "Kowalska")
  , ("Jan", "Mazur")
  , ("Ewa", "Kaczmarek")
  , ("Piotr", "Lewandowski")
  ]

listB :: [Int]
listB = [10 * tens + ones | tens <- [3, 5, 7], ones <- [3, 4]]

listA1 :: [String]
listA1 = map fst listA

listA2 :: [String]
listA2 = map snd listA

people :: [(String, String, Int)]
people = [(name, surname, age) | (name, surname) <- listA, age <- listB]

unitaryN :: Int -> [[Int]]
unitaryN n =
  [ [if i == j then 1 else 0 | j <- [1 .. n]]
  | i <- [1 .. n]
  ]

threeDigitDivBy3Distinct :: [Int]
threeDigitDivBy3Distinct =
  [ 100 * a + 10 * b + c
  | a <- [1 .. 9]
  , b <- [0 .. 9]
  , c <- [0 .. 9]
  , (100 * a + 10 * b + c) `mod` 3 == 0
  , a /= b
  , a /= c
  , b /= c
  ]

-- Recursion on lists

firstFromList :: [a] -> a
firstFromList (x : _) = x
firstFromList [] = error "Empty list"

secondFromList :: [a] -> a
secondFromList (_ : y : _) = y
secondFromList _ = error "Too short"

lastFromList :: [a] -> a
lastFromList [x] = x
lastFromList (_ : xs) = lastFromList xs
lastFromList [] = error "Empty list"

prelastFromList :: [a] -> a
prelastFromList [x, _] = x
prelastFromList (_ : xs) = prelastFromList xs
prelastFromList _ = error "Too short"

reverseRec :: [a] -> [a]
reverseRec [] = []
reverseRec (x : xs) = reverseRec xs ++ [x]

isPalindromeRec :: Eq a => [a] -> Bool
isPalindromeRec xs = xs == reverseRec xs

-- Sequences and primes

cSequence :: [Int]
cSequence = iterate (\x -> 1 + 2 * x) 1

c15 :: Int
c15 = cSequence !! 14

firstNC :: Int -> [Int]
firstNC n = take n cSequence

cBelow1000 :: [Int]
cBelow1000 = takeWhile (< 1000) cSequence

isPrime :: Int -> Bool
isPrime n
  | n < 2 = False
  | otherwise = null [d | d <- [2 .. floor (sqrt (fromIntegral n))], n `mod` d == 0]

nPrimes :: Int -> [Int]
nPrimes n = take n [x | x <- [2 ..], isPrime x]

abPairs :: [(Integer, Integer)]
abPairs = iterate (\(a, b) -> (a + b, a * b)) (1, 1)

aSequence :: [Integer]
aSequence = map fst abPairs

bSequence :: [Integer]
bSequence = map snd abPairs

-- where and let

cuboidSurfaceWhere :: Num a => a -> a -> a -> a
cuboidSurfaceWhere x y z = 2 * base + 2 * front + 2 * side
  where
    base = x * y
    front = x * z
    side = y * z

cuboidSurfaceLet :: Num a => a -> a -> a -> a
cuboidSurfaceLet x y z =
  let base = x * y
      front = x * z
      side = y * z
   in 2 * base + 2 * front + 2 * side

-- IO and files

readTwoNumbersAndShowSumDiff :: IO ()
readTwoNumbersAndShowSumDiff = do
  x <- (readLn :: IO Double)
  y <- (readLn :: IO Double)
  putStrLn ("Sum: " ++ show (x + y))
  putStrLn ("Difference: " ++ show (x - y))

repeatStringNTimesIO :: IO ()
repeatStringNTimesIO = do
  s <- getLine
  n <- (readLn :: IO Int)
  if n < 0
    then putStrLn "Invalid value n"
    else mapM_ putStrLn (replicate n s)

displayFile :: FilePath -> IO ()
displayFile path = do
  content <- readFile path
  putStr content

writeUserTextToFile :: FilePath -> IO ()
writeUserTextToFile path = do
  s <- getLine
  writeFile path s

reverseLinesToNewFile :: FilePath -> FilePath -> IO ()
reverseLinesToNewFile sourcePath targetPath = do
  content <- readFile sourcePath
  writeFile targetPath (unlines (reverse (lines content)))

fileStatsPure :: String -> (Int, Int, Int, Int)
fileStatsPure content =
  ( length (lines content)
  , length (words content)
  , length (filter isLetter content)
  , length (filter (/= ' ') content)
  )

fileStats :: FilePath -> IO ()
fileStats path = do
  content <- readFile path
  let (lineCount, wordCount, letterCount, nonSpaceCount) = fileStatsPure content
  putStrLn ("Lines: " ++ show lineCount)
  putStrLn ("Words: " ++ show wordCount)
  putStrLn ("Letters: " ++ show letterCount)
  putStrLn ("Non-space characters: " ++ show nonSpaceCount)