module ParserExtTests (
parseMorse,
encodeMorse
) where
import Utils
import ParsecExt
import Control.Applicative hiding (many)
import Text.ParserCombinators.Parsec hiding ((<|>),State)
import Control.Monad
import Data.List
import Data.Maybe
import Control.Monad.State

---------------------------------------------------------------------------------------------
------------------------- parsec ext usage samples ------------------------------------------
---------------------------------------------------------------------------------------------

type ExampleCase = ([String], String, String)

parsersChain :: [StringStateParser ExampleCase]
parsersChain = square3 prefix mid suffix
        where -- all parsers except for last one should consume some input and give some output
            prefix = manyCases ((:[]) <$> (string "ab" <|> string "zz"))
            mid =    many1Cases $ (:[]) <$> letter            -- list of letters
            suffix = many1Cases $ try $ many1 alphaNum  
            

testParsecExt :: Either ParseError [([String], String, String)]
testParsecExt =  parse (cases parsersChain <* string "$$") "x" "abebz12$$"

testParseMorse :: Either ParseError [String]
testParseMorse = parseMorse "......-...-..---"

--------------------------------------------------------------------------------
--- Morse chars parsing: parse "......-...-..---" in all possible ways ---------
--------------------------------------------------------------------------------

morseChars :: [(String, Char)]
morseChars = [  (".-", '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')]

morseCharCodes :: [String]
morseCharCodes = fst <$> morseChars

-- HELLO = "......-...-..---"
encodeMorse :: String -> String
encodeMorse s = join $ fst <$> catMaybes (code <$> s)
        where code c = find (\pair -> snd pair == c) morseChars
        
decodeMorse :: [String] -> String
decodeMorse ss = snd <$> catMaybes (code <$> ss)
        where code s = find (\pair -> fst pair == s) morseChars 


-- find possibilites to continue from a given prefix
findMorseSteps :: String -> [String] -> [String]
findMorseSteps prefix codes = case find (== prefix) codes of
                            Nothing -> case filter (isPrefixOf prefix) codes of 
                                            [] -> []
                                            filtered ->    findMorseSteps (prefix ++ ".") filtered
                                                        ++ findMorseSteps (prefix ++ "-") filtered
                            Just match -> [match]

morseStepParser :: [String] -> Parser String
morseStepParser [] = pzero
morseStepParser [step] = string step
morseStepParser (step:steps') = string step <|> morseStepParser steps'

morseParser :: Int -> StringStateParser (ZipListM String)
morseParser pos = do     acc' <- get
                         let acc = case acc' of
                                      Nothing -> ""
                                      Just val -> val
                             candidates = filter (\x -> isPrefixOf acc x && acc /= x) morseCharCodes
                             steps = drop (length acc) <$> findMorseSteps acc candidates
                             parser = morseStepParser steps    
                         res <- lift parser
                         put (Just $ acc ++ res)
                         return (zipListM $ (replicate pos "") ++ (res : repeat ""))
                  

morseParsers :: [StringStateParser (ZipListM String)]
morseParsers = repeat morseParser <*> [0 ..]

parseMorse :: String -> Either ParseError [String]
parseMorse s = (fmap.fmap) postProcess $ parseMorseRaw "x" s
            where 
            parseMorseRaw =  parse (cases $ morseParsers) 
            postProcess = decodeMorse.toLists 
            toLists = (takeWhile $ not.null) . getZipListM