-- University of Zagreb
-- Faculty of Electrical Engineering and Computing
--
-- PROGRAMMING IN HASKELL
--
-- Academic Year 2013/2014

-- The following are some *example* solutions to the 5th homework
-- assignment. You were not required to write them out exactly like
-- this. If you spot an error somewhere, please notify us. Thanks!

module Homework where

import Data.List

-- 1
concatMap' :: (a -> [b]) -> [a] -> [b]
concatMap' _ []     = []
concatMap' f (x:xs) = f x ++ concatMap' f xs

-- 2
reduce :: (a -> b -> a) -> a -> [b] -> a
reduce _ acc []     = acc
reduce f acc (x:xs) = reduce f (f acc x) xs

-- 3
reduce1 :: (a -> a -> a) -> [a] -> a
reduce1 _ []     = error "reduce1 got an empty list"
reduce1 f (x:xs) = reduce f x xs

-- 4
type Vertex = Integer
type Graph  = [(Vertex, Vertex)]
type Map    = [(Vertex, Integer)]
type Queue  = [Vertex]

-- 4a
popFromQ :: Queue -> (Vertex, Queue)
popFromQ []     = error "Empty queue"
popFromQ (x:xs) = (x, xs)

-- 4b
pushToQ :: Queue -> Vertex -> Queue
pushToQ xs x = xs ++ [x]

-- 4c
isEmptyQ :: Queue -> Bool
isEmptyQ = null

-- 4d
isInQ :: Queue -> Vertex -> Bool
isInQ = flip elem

-- 4e
getQSingleton :: Vertex -> Queue
getQSingleton = (:[])

-- 4f
getValFor :: Map -> Vertex -> Integer
getValFor m x = foldl (\acc (k, v) -> if k == x then v else acc) (-1) m

-- 4g
putKeyVal :: Map -> Vertex -> Integer -> Map
putKeyVal m k v = (k, v) : filter ((/= k) . fst) m

-- 4h
isKeyInMap :: Map -> Vertex -> Bool
isKeyInMap m k = not . null $ filter ((== k) . fst) m

-- 4i
getMapSingleton :: Vertex -> Integer -> Map
getMapSingleton k v = [(k, v)]

-- 4j
shortestPath :: Vertex -> Vertex -> Graph -> Integer
shortestPath v1 v2 g = bfs g v2 (getQSingleton v1) $ getMapSingleton v1 0

bfs :: Graph -> Vertex -> Queue -> Map -> Integer
bfs _ _ [] _  = (-1)
bfs g t q m
  | t == h    = getValFor m h
  | otherwise = bfs g t nq nm
    where (h, qs) = popFromQ q
          i = getValFor m h
          neighbours v = [y | (x,y) <- g, x == v] ++ [y | (y, x) <- g, x == v]
          newV = filter (not . isKeyInMap m) $ neighbours h
          nq = foldl pushToQ qs newV
          nm = foldl (\acc x -> putKeyVal acc x (i+1)) m newV

-- 5
type FileSystem      = [(FilePath, [FilePath])]
type FileSystemState = (FilePath, FileSystem)

-- 5a
pwd :: FileSystemState -> FilePath
pwd = fst

-- 5b
ls :: FileSystemState -> String
ls (fp, fs) = unwords . concatMap snd $ filter ((==fp) . fst) fs

-- 5c
buildAbsPath :: FilePath -> FilePath -> FilePath
buildAbsPath a b
  | "/" `isPrefixOf` b || null a = process b
  | "/" `isSuffixOf` a           = process $ a ++ b
  | otherwise                    = process $ a ++ "/" ++ b
  where
    process = join . collapse . splitOn '/'

    join [""] = "/"
    join []   = ""
    join ps   = intercalate "/" ps

splitOn :: Char -> String -> [String]
splitOn _ [] = []
splitOn d cs = prefix : splitOn d (if null suffix then suffix else tail suffix)
  where
    (prefix, suffix) = span (/=d) cs

collapse :: [String] -> [String]
collapse = reverse . foldl' f []
  where
    f st x = case x of
      ""   -> "" : st
      "."  -> st
      ".." -> moveUp st
      _    -> x : st

    moveUp [] = []
    moveUp ps@("":_) = ps
    moveUp (_:ps) = ps

-- 5d
cd :: FileSystemState -> FilePath -> FileSystemState
cd (wd, fs) new
  | target `elem` map fst fs = (target, fs)
  | otherwise                = error "There is no such directory"
  where
    target = withTrailingSlash $ buildAbsPath wd new

withTrailingSlash :: FilePath -> FilePath
withTrailingSlash p
  | "/" `isSuffixOf` p = p
  | otherwise          = p ++ "/"

-- 5e
-- TODO FIXME