added tap code
This commit is contained in:
parent
f06925d9b8
commit
6213a4a221
|
@ -1,76 +0,0 @@
|
||||||
-- This module's code leans heavily on Andy Stewarts' Morse Code implementation in Text.Morse
|
|
||||||
module Encoding.Tap
|
|
||||||
( enctap
|
|
||||||
, dectap
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Data.Char (toLower, isSpace)
|
|
||||||
import Data.Map (Map)
|
|
||||||
import Data.List.Split (split, dropDelims, dropFinalBlank, oneOf)
|
|
||||||
import Data.ByteString (ByteString)
|
|
||||||
import qualified Data.Map as M
|
|
||||||
import qualified Data.ByteString.Char8 as BC
|
|
||||||
|
|
||||||
-- | Morse Code convert map.
|
|
||||||
tapCode :: Map Char String
|
|
||||||
tapCode =
|
|
||||||
M.fromList
|
|
||||||
[('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', "..... .....")]
|
|
||||||
|
|
||||||
enctap :: ByteString -> ByteString
|
|
||||||
enctap = BC.pack . concatMap encodeChar . BC.unpack
|
|
||||||
where
|
|
||||||
encodeChar c
|
|
||||||
| isAlpha c = case M.lookup (toLower c) tapCode of
|
|
||||||
Just code -> code
|
|
||||||
Nothing -> [c]
|
|
||||||
| isSpace c = "/"
|
|
||||||
| otherwise = [c]
|
|
||||||
-- encodeChar x =
|
|
||||||
-- case findMinMatch tapCode (\k _ -> k == toLower x) of
|
|
||||||
-- Just (_, tap) -> tap
|
|
||||||
-- Nothing -> if isSpace x then "/" else ""
|
|
||||||
|
|
||||||
dectap :: ByteString -> ByteString
|
|
||||||
dectap input = BC.pack $ concatMap decodeSegment $ split (oneOf "/" ) $ BC.unpack input
|
|
||||||
where
|
|
||||||
decodeSegment x
|
|
||||||
| x == "/" = " "
|
|
||||||
| otherwise = concatMap decodeTap (split (dropDelims $ dropFinalBlank $ oneOf " ") x)
|
|
||||||
|
|
||||||
decodeTap lv =
|
|
||||||
case findMinMatch tapCode(\ _ v -> v == lv) of
|
|
||||||
Just (c, _) -> [c]
|
|
||||||
Nothing -> []
|
|
||||||
|
|
||||||
findMinMatch :: Ord k => Map k a -> (k -> a -> Bool) -> Maybe (k, a)
|
|
||||||
findMinMatch map fun = match
|
|
||||||
where filterMap = M.filterWithKey fun map
|
|
||||||
match = if M.null filterMap
|
|
||||||
then Nothing
|
|
||||||
else Just $ M.findMin filterMap
|
|
Loading…
Reference in New Issue