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