module Exercise_12_Sol where

import qualified Data.ByteString as BS
import Data.Bits
import Data.List
import Data.List.Split
import Data.Word (Word8)
import qualified Huffman as H
import Morse
import SkewHeap


{-G12.1-}

serializeHuff :: [H.Bit] -> BS.ByteString
serializeHuff = BS.pack . ser
  where
    ser bits = if len == 8
      then ch8 : ser bits2
      else [ch8 `shiftL` (8 - len), fromInteger $ toInteger len]
       where
        (bits1, bits2) = splitAt 8 bits
        len = length bits1 
        ch8 = toWord8 0 bits1

    toWord8 n [] = n
    toWord8 n (H.L:xs) = toWord8 (n `shiftL` 1) xs
    toWord8 n (H.R:xs) = toWord8 ((n `shiftL` 1) .|. 1) xs

deserializeHuff :: BS.ByteString -> Maybe [H.Bit]
deserializeHuff = deser . BS.unpack
  where
    deser :: [Word8] -> Maybe [H.Bit]
    deser [x,l] = Just $ take (fromInteger $ toInteger l) (fromWord8 x)
    deser (x:xs) = case deser xs of
                    Nothing -> Nothing
                    Just res -> Just $ fromWord8 x ++ res
    deser _ = Nothing

    fromWord8 c = reverse [ if testBit c n then H.R else H.L | n <- [0..7] ]

compress :: String -> FilePath -> IO ()
compress xs file = do
    BS.writeFile (file ++ ".code") (H.serializeTree tree)
    BS.writeFile (file ++ ".huff") (serializeHuff huff)
  where
    tree = H.mkTree $ H.mkFTable xs
    huff = H.encode (H.mkCTable tree) xs

decompress :: FilePath -> IO (Maybe String)
decompress file = do
    rawTree <- BS.readFile (file ++ ".code")
    rawHuff <- BS.readFile (file ++ ".huff")
    let tree = H.deserializeTree rawTree
    return $ case deserializeHuff rawHuff of
      Nothing -> Nothing
      Just huff -> Just $ H.decode tree huff


{-G12.2-}

newtype Reversed a = Reversed a deriving (Eq, Show)

instance Ord a => Ord (Reversed a) where
  compare (Reversed x) (Reversed y) = compare y x

type RevHeap a = Heap (Reversed a)


{-H12.1-}

morseMap :: [(MorseLetter, Char)]
morseMap = [(map charToMorse ms, c) | (c, ms) <- raw]
 where raw = [('A', ".-"), ('B', "-..."), ('C', "-.-."), ('D', "-.."), ('E', "."), ('F', "..-."), ('G', "--."),
              ('H', "...."), ('I', ".."), ('J', ".---"), ('K', "-.-"), ('L', ".-.."), ('M', "--"), ('N', "-."),
              ('O', "---"), ('P', ".--."), ('Q', "--.-"), ('R', ".-."), ('S', "..."), ('T', "-"), ('U', "..-"),
              ('V', "...-"), ('W', ".--"), ('X', "-..-"), ('Y', "-.--"), ('Z', "--.."), ('0', "-----"), 
              ('1', ".----"), ('2', "..---"), ('3', "...--"), ('4', "....-"), ('5', "....."), ('6', "-...."), 
              ('7', "--..."), ('8', "---.."), ('9', "----.")]
       charToMorse '.' = Dit
       charToMorse '-' = Dah

morseLetterToChar :: MorseLetter -> Maybe Char
morseLetterToChar m = lookup m morseMap

morseWordToString :: MorseWord -> Maybe String
morseWordToString = sequence . map morseLetterToChar . filter (not . null)

morseToString :: MorseSequence -> Maybe String
morseToString ms = case sequence (map morseWordToString ms) of
                     Nothing -> Nothing
                     Just ms -> Just (unwords ms)
-- etwas knapper:
morseToString' = fmap unwords . sequence . map morseWordToString


{-H12.2-}

data Pause = ShortPause | LongPause deriving (Eq, Ord, Show)

bitStreamToMorse :: Int -> [Bool] -> MorseSequence
bitStreamToMorse ditLength = map splitIntoLetters . splitIntoWords . analyzeBitStream
  where -- Verarbeitet Eingabe zu einer Liste von Morse-Codes und Pausen 
        analyzeBitStream :: [Bool] -> [Either Pause Morse]
        analyzeBitStream bs = concat [analyzeInterval (head xs) (length xs) | xs <- group bs]
        
        -- Gibt zu einem Intervall gegebener Länge von Signal (True) oder kein Signal (False) das dazugehörige 
        -- Morse-Symbol (Dit/Dah) oder die dazugehörige Pause (ShortPause/LongPause/nichts) zurück.
        analyzeInterval :: Bool -> Int -> [Either Pause Morse]
        analyzeInterval True  len
          | len < 2 * ditLength = [Right Dit] -- kurzes Intervall auf 1, also .
          | otherwise           = [Right Dah] -- langes Intervall auf 1, also -
        analyzeInterval False len
          | len < 2 * ditLength = []    -- Pause mit Länge eines Dits, also Zwischenraum zwischen zwei Codezeichen
          | len < 5 * ditLength = [Left ShortPause] -- Pause mit Länge eines Dahs, also Abstand zwischen zwei Buchstaben
          | otherwise           = [Left LongPause]  -- Pause mit Länge deutlich über eines Dahs, also Leerzeichen

        -- Trennt die Sequenz an Morsecodes und langen/kurzen Pausen an jeder langen Pause auf
        splitIntoWords :: [Either Pause Morse] -> [[Either Pause Morse]]
        splitIntoWords = filter (not . null) . splitOn [Left LongPause]
        
        -- Trennt die Sequenz an Morsecodes und kurzen Pausen an kurzen Pausen auf. Das Ergebnis ist eine Liste 
        -- einzelnen Morse-"Buchstaben", die keine Pausen mehr enthält.
        splitIntoLetters :: [Either Pause Morse] -> MorseWord
        splitIntoLetters = map (map (\(Right m) -> m)) . filter (not . null) . splitOn [Left ShortPause]