added tap code

This commit is contained in:
Stefan Friese 2024-07-02 23:03:58 +02:00
parent f06925d9b8
commit 6213a4a221
1 changed files with 0 additions and 76 deletions

View File

@ -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