path: root/comp3141/hare/Hare.hs

module Hare where

import Data.Traversable
import Data.Word
import Data.List
import Data.Maybe
import Control.Monad.State
import Test.QuickCheck
import GHC.Enum

import RoverInterface
import RoverModel

-- PART 1: FINDING WAYPOINTS

data Path wp
  = From wp
  | GoTo (Path wp) wp
  deriving (Eq)

instance Show wp => Show (Path wp) where
  show (From x) = "From " ++ show x
  show (GoTo xs x) = show xs ++ " >:> " ++ show x

-- Problem 1. Define a function `wf` that returns `True`
-- precisely if a given `Path` is well-formed according
-- to the rules set out in the specification.

-- turn recrsive path into more managable list of waypoints
recurse_waypoints :: (Wp wp) => Path wp -> [wp] -> [wp]
recurse_waypoints (From wp) paths = paths ++ [wp]
recurse_waypoints (GoTo p wp) paths = paths ++ [wp] ++ (recurse_waypoints p paths)

path_to_waypoints :: (Wp wp) => Path wp -> [wp]
path_to_waypoints p = recurse_waypoints p []

get_waypoint :: (Wp wp) => Path wp -> wp
get_waypoint (From wp) = wp
get_waypoint (GoTo p wp) = wp

wf :: (Wp wp) => Path wp -> Bool
wf (From wp) = True                        -- a path From x is always well formed
wf (GoTo p wp) = 
    ((wp) `elem` (navigableFrom next)) &&  -- x is navigable from the endpoint of the path xs
    (wf p) &&                              -- the path xs is itself well formed
    ((nub waypoints) == waypoints) where   -- only unique waypoints
        waypoints = (path_to_waypoints p) ++ [wp]
        next = (get_waypoint p)

-- Problem 2. Define a smart constructor `>:>` for `GoTo`
-- that returns `Nothing` if adding the given waypoint
-- to the given path would result in a non-well-formed path.
(>:>) :: (Wp wp) => Path wp -> wp -> Maybe (Path wp)
p >:> wp = if (wf new_path) then (Just new_path) else Nothing where
        new_path = (GoTo p wp)

-- Problem 3. Write a function `extendPath` which returns
-- all possible ways of extending the given `Path` by appending
-- a single additional waypoint.

extendPath :: (Wp wp) => Path wp -> [Path wp]
extendPath p = catMaybes (map (\potential -> (p >:> potential)) potentials) where
        potentials = navigableFrom (get_waypoint p)

-- Problem 4. Implement a function `findPaths` which returns
-- all possible ways of extending the given `Path` (by appending
-- any number of additional waypoints) into a path that ends
-- at the given target waypoint.

make_full_solution :: (Wp wp) => [Path wp] -> wp -> [Path wp]
make_full_solution paths target = 
    if ((length incomplete) <= 0) then solutions else solutions ++ (make_full_solution incomplete target) where
        potential = concat (map (\p -> extendPath p) paths)
        incomplete = filter (\p -> (head (path_to_waypoints p)) /= target) potential
        solutions = filter (\p -> (head (path_to_waypoints p)) == target) potential

findPaths :: (Wp wp) => Path wp -> wp -> [Path wp]
findPaths p target = if ((get_waypoint p) == target) then [p] else make_full_solution [p] target

-- Efficiency mark 5: your solution should not spend time
-- expanding "useless" partial solutions.




--- PART 2: DISK MATTERS - ENCODE/DECODE

-- The floppy disk drive has no means of tracking the
-- angular position of the spinning magnetic disk.
-- This means that in principle, reading/writing can
-- begin at any position within the track, and the
-- user has no control over where the reading/writing
-- starts from.

-- For example, if you write [1,2,3,4,5,6] on a track of
-- capacity 6, it can happend that reading the track next
-- time will result in [5,6,1,2,3,4] or [2,3,4,5,6,1]. Note
-- however that the disk can spin only in one direction, so
-- you will never get a result like [6,5,4,3,2,1].

-- In this subproblem, you will come up with an encoding
-- scheme gets around the problem of the spinning disk.

-- represents a list of bytes encoded using the scheme

-- 
data Encoded = Encoded [Word8] deriving (Show, Eq)

unEncoded :: Encoded -> [Word8]
unEncoded (Encoded ws) = ws

-- Problem 5. Implement a function `rotate` which simulates
-- the effect of the spinning disk by rotating the given
-- list to the left by the given number of entries. E.g.
-- rotate 3 (Encoded [1,2,3,4]) = Encoded [4,1,2,3]
-- Hint: for negative n, you get to choose the behavior.

rotate_generic amount e = (b ++ a) where
        (a, b) = splitAt (amount `rem` (max (length e) 1)) e

rotate :: Int -> Encoded -> Encoded
rotate amount (Encoded e) = Encoded (rotate_generic amount e)

-- Problem 6. Come up with an encoding scheme which gets
-- around the problem of the spinning disk. More formally,
-- implement a pair of functions, `encode` and `decode`, so
-- that:
--
-- 1. Decoding an encoded list of bytes results in the
-- original list, i.e. decode (encode bs) = Just bs.
-- 2. Decoding is rotationally invariant, i.e.
-- decode . rotate n . encode = Just for any positive n.

header :: [Word8]
header = [(fromIntegral 7), (fromIntegral 47)]

terminator :: [Word8]
terminator = [(fromIntegral 97), (fromIntegral 178)]

encoded_size :: [Word8] -> Int
encoded_size d = (2 * (length d)) + (length header) + (length terminator)

-- encode = 50, 100, 150 + data * 2 + null terminator
encode :: [Word8] -> Encoded
encode d = Encoded (header ++ d ++ d ++ terminator)


decode :: Encoded -> Maybe [Word8]
decode (Encoded e) = 
    if ((maybe_terminator /= terminator) || (maybe_header /= header) || (first /= second)) 
    then decode (Encoded (rotate_generic 1 e)) 
    else Just first where
        maybe_header = take 2 e
        maybe_terminator = reverse (take 2 (reverse e))
        between = tail (tail (init (init e)))
        (first, second) = splitAt ((length between) `div` 2) between

-- Efficiency mark: encoding a list of bytes with length
-- no more than 16 should result in an encoded list of
-- length no more than 37.


-- PART 3: FILE SYSTEM HIERARCHY

-- The rover's in-memory file system is organized into files and
-- directories. Each directory may contain other files and
-- directories inside it. Each file and directory is identified
-- by a unique `Word8`, its UID.


-- You can make the following assumptions about the file
-- system of the rover:
-- 1. The total size of all the files is no more than
--    16kiB (16384 bytes).
-- 2. Every file is at most 3072 bytes long.
-- 3. There are at most 48 files and directories (but their
--    UIDs need not be in the range 0-47) altogether.


-- We have decided that one track on the disk will store the
-- contents of at most one file, i.e. that there will not be
-- any tracks which store multiple files.

-- However, since floppy tracks store only 2048 bytes, and a
-- single file may be longer than 2048 bytes, we will have to
-- come up with a way of storing a single file across multiple
-- tracks.

-- We will divide each file into a list of chunks, so that each
-- chunk is short enough to be stored in a single track. We will
-- assign each chunk its own unique track.

-- To reassemble a file, we have to read and decode each of its
-- chunks from the disk in order, then concatenate the results.

data Chunk =
  Chunk TrackNo Encoded deriving (Show, Eq)

-- Problem 7. Write a stateful function `chunks` which,
-- when given the contents of a file, divides it into
-- a list of `Chunk`s.

-- The state `n` is a `TrackNo` between 0 and 255,
-- denoting the first track that is still available
-- to store data. E.g. if the state is 12, then
-- tracks 0-11 have already been used to store chunks,
-- but tracks 12-39 are still available. If all tracks
-- have been exhausted, signal the error by assiginng
-- the remaining chunks to track 40.

split_amount = (2048 `div` 2) - 4 -- encoding is data * 2 + 4

tn_max :: TrackNo
tn_max = fromIntegral 40

split_into_n :: Int -> [Word8] -> [[Word8]]
split_into_n n d = if (length d) <= n then [d] else [split] ++ concat [(split_into_n n rest)] where
    (split, rest) = splitAt n d

chunks :: [Word8] -> State TrackNo [Chunk]
chunks d = do
    tn <- get
    put (min (tn + (fromIntegral (length cx))) tn_max)
    return (map (\(Chunk tnn ee) -> Chunk (min (tn + tnn) tn_max) ee) cx) where
        splits = split_into_n split_amount d
        cx = map (\s -> Chunk (fromIntegral (fromJust (elemIndex s splits))) (encode s)) splits

-- The `FSH t` data type represents a file system hierarchy
-- in which each file is annotated with data of type `t`.
-- For example, `FSH [Word8]` can be used to represent the
-- entire file system, where each file is annotated with its
-- contents (a list of bytes), while the type `FSH ()` can
-- be used to represent just the hierarchical relationships
-- between the files and directories (i.e. which contains
-- which), but without any of the file data.

-- Problem 8. Write a lawful Functor instance for the FSH
-- type.

instance Functor FSH where
  fmap f (File uid a) = (File uid (f a))
  fmap f (Dir uid arr) = (Dir uid (map (fmap f) arr))

--instance Traversable FSH where
--  traverse f (File uid elem) = File uid <$> f elem
--  traverse f (Dir uid arr) = do
--      fx <- fmap (traverse f) arr
--      return $ Dir uid fx

--instance Traversable FSH where
--    traverse f (File uid elem) = File <$> uid <*> f elem
--    traverse f (Dir uid arr) = Dir <$> uid <*> (map (traverse f) arr)

--instance Traversable FSH where
--    traverse f (File uid elem) = File <$> uid <*> f elem
--    traverse f (Dir uid arr) = Dir <$> uid <*> (map (\x -> traverse f x) arr)

--instance Traversable FSH where
--    traverse f (File uid a) = (File uid (f a))
--    traverse f (Dir uid arr) = (Dir uid (map (traverse f) arr))

-- parseElems :: Traversal' Term Term


  --traverse f (Dir uid arr) = (Dir (uid) (map (\x -> traverse f x) arr))
-- We will have to save the whole directory hierarchy to
-- disk before the rover is rebooted. So that we can reassemble
-- the hierarchy, we will use Track 0 to store a "header". This
-- header will represent a `FSH [TrackNo]` object, where each
-- file is annotated with the list of tracks that contain its
-- chunks.

-- The `mkHeader` function below will create this header
-- from a file system hierarchy where each file has been
-- annotated with a list of its chunks (assuming your
-- `Functor` instance is correct).

mkHeader :: FSH [Chunk] -> FSH [TrackNo]
mkHeader = fmap (map (\(Chunk n _) -> n))


-- Problem 9. Implement a function `assignTracks` which divides
-- all files in a hierarchy into chunks. Each chunk should have
-- be assigned its unique track number. Do not allocate track 0,
-- as that will be used to store the header.
-- Return `Nothing` if the given file system would not fit on
-- tracks 1-39 of a 40-track disk under your encoding.
-- HINT: You'll probably want to have a separate function
-- with return type `State TrackNo (FSH [Chunk])`.

state_lambda :: [Word8] -> State TrackNo [Chunk]
state_lambda d = do
    tn <- get
    let (cc, tt) = (runState (chunks d) tn)
    put tt
    return cc

--state_tracks :: FSH [Word8] -> State TrackNo (FSH [Chunk])
--state_tracks fshd = do
--    state <- get
    --m <- (mapM (\x -> do
    --    c <- chunks x
    --    return c
    --    ) fshd)
    --return m

-- AHHHHHHHHHHHHHHHHHh
--state_tracks fshd = do
    --let asdf = fmap state_lambda fshd
    --return (fmap (state_lambda) fshd)
    --return (fmap (\x -> evalState (state_lambda x) 1) fshd)
    --return (fmap (\x -> evalState (state_lambda x) 1) fshd)
    --return (fmap (\c -> do 
    --    let (cc, tt) = (runState (chunks c) tn)
    --    return (head cc)) fshd)
    --return (fmap (\c -> do 
    --    tn <- get
    --    let cc = (evalState (chunks c) tn)
    --    modify (+ fromIntegral (length cc))
    --    return cc) fshd) where
--fmap' :: FSH [Word8]
--fmap' f (File uid a) = (File uid (f a))
--fmap' f (Dir uid arr) = (Dir uid (map (fmap f) arr))


--assignTracks :: FSH [Word8] -> Maybe (FSH [Chunk])
--assignTracks fshd = 
--    if (tn >= tn_max) then Nothing else Just tracks where
--        (tracks, tn) = runState (state_tracks fshd) 1


-- PART 4 - DISK CONTROLLER

-- The disk controller supports four operations:
--   headForward - moves the read/write head forward by 1 track.
--   headBackward - moves the r/w head back toward zero by 1 track.
--   readTrack - reads 2048 consecutive bytes from the current track.
--   writeTrack - writes the given list of bytes to the current track.

-- In this problem, you will develop a program `saveFSH` that
-- uses this monad to save the entire file system onto the disk.

-- Problem 10. Write a program `headToTrack` that positions
-- the r/w head of the disk drive on the track with the given
-- number. If the number is larger than 39, position the head
-- on track 39.

head_forward_n :: (MonadFloppy m) => Word8 -> m ()
head_forward_n n = do
    if (n > 0) then do
        headForward
        head_forward_n (n - 1)
        else do
            return ()

head_backward_n :: (MonadFloppy m) => Word8 -> m ()
head_backward_n n = do
    if (n > 0) then do
        headBackward
        head_backward_n (n - 1)
        else do
            return ()

headToTrack :: (MonadFloppy m) => Word8 -> m ()
headToTrack p = do
    head_backward_n 40
    head_forward_n p

-- Problem 11. Write a program `saveChunk` which writes the
-- given chunk onto the appropriate track of the disk.

saveChunk :: (MonadFloppy m) => Chunk -> m ()
saveChunk (Chunk n (Encoded e)) = do
    headToTrack n
    writeTrack (replicate 2048 0)
    writeTrack e

-- The function below calculates the header of the
-- given given `FSH [Chunk]`, and saves it to track 0
-- of the disk. Notice the use of the `toBytes` function.

saveHeader :: (MonadFloppy m) => FSH [Chunk] -> m ()
saveHeader fsh = do
  headToTrack 0
  writeTrack (replicate 2048 0)
  writeTrack (unEncoded $ encode $ toBytes $ mkHeader fsh)


-- Problem 12. Implement a program `saveFSH` that attemps to assign
-- track to the given `fsh` using `assignTracks`. If the assignment
-- was unsuccessful, the program should return False.
-- If the assignment was successful, the program should write the
-- header to track 0 of the disk, then write all the assigned chunks
-- onto the appropriate tracks.

saveFSH :: (MonadFloppy m) => FSH [Word8] -> m Bool
saveFSH  = error "'saveFSH' not implemented"

-- Implement a program `loadFSH` that is able to reload a file
-- system from disk. I.e. if `saveFSH fsh` returns `True`, then
-- (saveFSH fsh >> loadFSH) should return `Just fsh`.
-- HINT: To load the header, you might want to use the `fromBytes`
--       function.

loadFSH :: (MonadFloppy m) => m (Maybe (FSH [Word8]))
loadFSH = error "'loadFSH' not implemented"