content: module ParserExtTests (
  testParsecExt,
  testParseMorse,
  encodeMorse
  ) where
  import Utils
  import ParsecExt
  import Control.Applicative hiding (many)
  import Text.ParserCombinators.Parsec hiding ((<|>),State)
  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 = fst =<< mapMaybe code s
          where code c = find (\pair -> snd pair == c) morseChars
  
  decodeMorse :: [String] -> String
  decodeMorse ss = snd <$> mapMaybe 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 = fromMaybe "" acc'
                               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 postProcess <$> parseMorseRaw "x" s
              where
              parseMorseRaw =  parse (cases morseParsers)
              postProcess = decodeMorse.toLists
              toLists = takeWhile (not . null) . getZipListM
  