функции

import Data.Char
 
data KeyCode = Sym Char | CapsLock | Shift Char deriving (Eq,Show) --множественный конструктор с использованием пользовательсих типов 
 
typCode :: KeyCode -> Int -- по коду возвращает его тип
typCode (Sym _)  = 0      -- обычная клавиша - тип=0
typCode CapsLock = -1    -- CapsLock - тип = -1
typCode (Shift _) = 1         -- Shift - тип = 1
 
getSym :: KeyCode -> Char
getSym (Sym   a) = a
getSym (Shift a) = a
 
 
getALNum :: [KeyCode] -> [KeyCode]
getALNum xs = [(Shift c) | (Shift c) <- xs]
 -- возвращает последовательность шифтов если встречается Shift, то он добавляется как элемент списка-результата.
--В квадратных скобках (в конструкторе списка) как бы описывается множество таких шифтов, которые принадлежат списку-аргументу.
 
getRaw :: [KeyCode] -> [KeyCode]
getRaw [] = []
getRaw (x:xs) | (typCode x) == 0  = x : (getRaw xs)
              | (typCode x) == -1 = getRaw xs
              | otherwise = (Sym (getSym x)) : getRaw xs
 
isCapsLocked  :: [KeyCode] -> Bool -> Bool
isCapsLocked [] cl = cl
isCapsLocked (x:xs) cl | (typCode x) == -1  = isCapsLocked xs (not cl)
                       | otherwise = isCapsLocked xs cl
 
 
getString :: [KeyCode] -> Bool -> String
getString [] _ = ""
getString (x:xs) cl | ((typCode x) == -1) = getString xs (not cl)
                    | ((typCode x) == 0) =  if cl then (toUpper (getSym x)) : (getString xs cl) else  (getSym x) : (getString xs cl) 
                    | otherwise = if (not cl) then (toUpper (getSym x)) : (getString xs cl) else  (getSym x) : (getString xs cl)

*Main> getString [Shift 'a',Sym 'b',Sym 'r',Sym 'a',Sym 'd',Sym 'a',Sym 'b', Sym 'r',Sym 'a'] True
"aBRADABRA"
it :: String
*Main> getString [Shift 'a',Sym 'b',Sym 'r',Sym 'a',Sym 'd',Sym 'a',Sym 'b', Sym 'r',Sym 'a'] False
"Abradabra"
it :: String

charToCode :: Char -> KeyCode
charToCode x = Sym x
 
charToShiftCode :: Char -> KeyCode
charToShiftCode x = Shift x
 
check :: (Eq a, Foldable t) => (a -> a) -> t a -> Bool
check f xs =  foldr ( \ x y -> (f x == x) && y ) True xs

check (getSym . charToCode) ['a'..'z']
True
check (getSym . charToCode) ['A'..'Z']
True
check (getSym . charToShiftCode) ['A'..'Z']
True
check (getSym . charToShiftCode) ['a'..'z']
True
check (charToCode . getSym) $ fmap Sym ['a'..'z']
True
check (charToCode . getSym) $ fmap Sym ['A'..'Z']
True
check (charToCode . getSym) $ fmap Shift ['A'..'Z']
False
check (charToCode . getSym) $ fmap Shift ['a'..'z']
False
check (charToShiftCode . getSym) $ fmap Shift ['A'..'Z']
True
check (charToShiftCode . getSym) $ fmap Sym ['A'..'Z']
False

import Data.Char
 
data KeyCode = Sym Char | CapsLock | Shift Char deriving (Eq,Show) 
 
-- Тип для перечисления конструкторов данных типа KeyCode 
data EnumKeyCode = EnumSym | EnumCapsLock | EnumShift deriving (Eq,Show)
 
typCode :: KeyCode -> EnumKeyCode -- по коду возвращает его тип
typCode (Sym _)  = EnumSym      -- обычная клавиша 
typCode CapsLock = EnumCapsLock    -- CapsLock 
typCode (Shift _) = EnumShift         -- Shift 
 
getSym :: KeyCode -> Char
getSym (Sym   a) = a
getSym (Shift a) = a
getSym _ = error "getSym : the argument is CapsLock"  
 
getALNum :: [KeyCode] -> [KeyCode]
getALNum  = filter ((== EnumShift) . typCode)
 
getRaw :: [KeyCode] -> [KeyCode]
getRaw [] = []
getRaw (x:xs) | (typCode x) == EnumSym  = x : (getRaw xs)
              | (typCode x) == EnumCapsLock = getRaw xs
              | otherwise = (Sym (getSym x)) : getRaw xs
 
isCapsLocked  :: [KeyCode] -> Bool -> Bool
isCapsLocked [] cl = cl
isCapsLocked (x:xs) cl | (typCode x) == EnumCapsLock  = isCapsLocked xs (not cl)
                       | otherwise = isCapsLocked xs cl
 
 
getString :: [KeyCode] -> Bool -> String
getString [] _ = ""
getString (x:xs) cl = case typCode x of
                        EnumCapsLock -> getString xs (not cl)
                        EnumSym -> go id
                        _       -> go not
    where go f = ((if f cl then toUpper else id) (getSym x)) : (getString xs cl)
                    
main :: IO ()
main = do
  let testdata = [Shift 'a',Sym 'b',Sym 'r',Sym 'a',CapsLock, Sym 'k',Sym 'a',Sym 'd',Sym 'a',Sym 'b', Sym 'r',Sym 'a']
  putStrLn "=== map typCode testdata ==="
  print $ map typCode testdata
  putStrLn "=== map getSym $ take 4 testdata ==="
  print $ map getSym $ take 4 testdata
  putStrLn "=== getALNum testdata ==="
  print $ getALNum testdata
  putStrLn "=== getRaw testdata ==="
  print $ getRaw testdata
  mapM_ (\b -> do
        putStrLn $ "=== isCapsLocked testdata " ++ show b ++ " ==="
        print $ isCapsLocked testdata b
        putStrLn $ "=== getString testdata " ++ show b ++ " ==="
        print $ getString testdata b
        ) [False,True]