-- |
-- Module      :  Composition.Sound.Keyboard
-- Copyright   :  (c) OleksandrZhabenko 2020-2021
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  olexandr543@yahoo.com
--
-- Helps to create experimental music from a file (or its part) and a Ukrainian text. 
-- It can also generate a timbre for the notes. Uses SoX inside.

{-# OPTIONS_GHC -threaded #-}

module Composition.Sound.Keyboard (
  -- * Working with input and files
  qwerty2dvorak
  , dvorak2qwerty
  , input2BL
  , input2BLN
  , input2BLMN
  , readFile2BL
  , readFile2BLN
  , readFile2BLMN
  , readFile2BLGen  
  , readFile2BLGenN
  , readFile2BLGenMN
  -- * Conversions
  , readFileDoubles
  , readFileDoublesN
  , readFileDoublesMN
  , readFileDoublesGen
  , readFileDoublesGenN
  , readFileDoublesGenMN
  , takeDoubles
  , hashStr2
  , convH
) where

import CaseBi.Arr (getBFstL',getBFstLSorted')
import Data.Char (isAsciiLower)
import GHC.Arr
import Data.Foldable.Ix
import GHC.Int (Int64)

-- | Converts a lazy 'String' into a list of 'Int' using 'hashStr2'. 
takeDoubles :: String -> [Int]
takeDoubles :: String -> [Int]
takeDoubles String
xs = (Char -> Char -> Int) -> String -> String -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Char -> Char -> Int
hashStr2 String
xs (String -> [Int]) -> String -> [Int]
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
tail String
xs

-- | Converts a string of lowercase ASCII letters being typed on the QWERTY keyboard layout into corresponding Dvorak keyboard layout.
qwerty2dvorak :: String -> String
qwerty2dvorak :: String -> String
qwerty2dvorak = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char -> [(Char, Char)] -> Char -> Char
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' Char
' ' (String -> String -> [(Char, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String
"/;<>" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'a'..Char
'z']) String
"wvszaxje.uidchtnmbrl'poygk,qf;"))

-- | Vice versa to 'qwerty2dvorak'.
dvorak2qwerty :: String -> String
dvorak2qwerty :: String -> String
dvorak2qwerty = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (Char -> [(Char, Char)] -> Char -> Char
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' Char
' ' (String -> String -> [(Char, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String
"',.;" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'a'..Char
'z']) String
"qwezanihdyujgcvpmlsrxo;kf.,bt/"))

-- | Hashes two lower case ascii characters. Is used for controlling frequencies and operators.
hashStr2 :: Char -> Char -> Int
hashStr2 :: Char -> Char -> Int
hashStr2 Char
x Char
y = Int -> [(Char, Int)] -> Char -> Int
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' Int
57 (String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Char
'a'..Char
'z'] ([Int] -> [(Char, Int)])
-> ([[Int]] -> [Int]) -> [[Int]] -> [(Char, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
t -> Int -> [(Char, Int)] -> Char -> Int
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstLSorted' (Int
26 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
18) (String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Char
'a'..Char
'z'] [(Int
26 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4)..]) Char
y) ([Int] -> [Int]) -> ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
  [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Int]] -> [(Char, Int)]) -> [[Int]] -> [(Char, Int)]
forall a b. (a -> b) -> a -> b
$ [[Int
0],[Int
6..Int
8],[Int
1],[Int
9..Int
11],[Int
4],[Int
12..Int
16],[Int
2],[Int
17..Int
21],[Int
3],[Int
22..Int
24],[Int
5,Int
25]]) Char
x -- 679 is the greatest value ~ \"zz\"; there are 572 effectful val.

-- | Get contents into lazy 'String' with filtering of all characters that are not a lower case ascii letters.
input2BL :: IO (String)
input2BL :: IO String
input2BL = (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> (String -> String) -> String -> String
convH [] ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAsciiLower)) IO String
getContents

-- | Like 'input2BL', but takes only first @n@ symbols specified with the first 'Int' argument.
input2BLN :: Int -> IO (String)
input2BLN :: Int -> IO String
input2BLN Int
n = (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> (String -> String) -> String -> String
convH [] (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAsciiLower)) IO String
getContents

-- | Like 'input2BL', but takes only first @n@ symbols specified with the second 'Int' argument dropping before this the first @m@ symbols specified 
-- with the first 'Int' argument.
input2BLMN :: Int -> Int -> IO (String)
input2BLMN :: Int -> Int -> IO String
input2BLMN Int
m Int
n = (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> (String -> String) -> String -> String
convH [] (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
m (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAsciiLower)) IO String
getContents

-- | Reads a given file into a lazy 'String' with filtering of all characters that are not a lower case ascii letters. It has additional 
-- first command line argument to control the way of treating letters: as being typed (entered) properly (null 'String'), or needed to be converted 
-- from qwerty to dvorak layout (\"q\" 'String'), or vice versa (otherwise).
readFile2BLGen :: String -> FilePath -> IO (String)
readFile2BLGen :: String -> String -> IO String
readFile2BLGen String
ys = (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> (String -> String) -> String -> String
convH String
ys ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAsciiLower)) (IO String -> IO String)
-> (String -> IO String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile

-- | Like 'readFile2BLGen', but reads only first @n@ symbols specified with the first 'Int' argument.
readFile2BLGenN :: Int -> String -> FilePath -> IO (String)
readFile2BLGenN :: Int -> String -> String -> IO String
readFile2BLGenN Int
n String
ys = (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> (String -> String) -> String -> String
convH String
ys (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAsciiLower)) (IO String -> IO String)
-> (String -> IO String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile

-- | Like 'readFile2BLGen', but reads only first @n@ symbols specified with the second 'Int' argument dropping before this the first @m@ symbols specified 
-- with the first 'Int' argument.
readFile2BLGenMN :: Int -> Int -> String -> FilePath -> IO (String)
readFile2BLGenMN :: Int -> Int -> String -> String -> IO String
readFile2BLGenMN Int
m Int
n String
ys = (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> (String -> String) -> String -> String
convH String
ys (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
m (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAsciiLower)) (IO String -> IO String)
-> (String -> IO String) -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile

-- | Auxiliary function to define how is a 'String' treated, see 'readFile2BLGen'.
convH :: String -> (String -> String) -> (String -> String)
convH :: String -> (String -> String) -> String -> String
convH String
ys String -> String
f 
 | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys = String -> String
f
 | String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"q" = String -> String
qwerty2dvorak (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
 | Bool
otherwise = String -> String
dvorak2qwerty (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
  
-- | Usual way the function 'readFile2BLGen' is used. The text in a file being read is treated as a properly typed (entered) one. So there is no 
-- keyboard layout conversion at all.
readFile2BL :: FilePath -> IO (String)
readFile2BL :: String -> IO String
readFile2BL = String -> String -> IO String
readFile2BLGen []
{-# INLINE readFile2BL #-}

-- | Like 'readFile2BL', but reads only first @n@ symbols specified with the first 'Int' argument.
readFile2BLN :: Int -> FilePath -> IO (String)
readFile2BLN :: Int -> String -> IO String
readFile2BLN Int
n = Int -> String -> String -> IO String
readFile2BLGenN Int
n []
{-# INLINE readFile2BLN #-}

-- | Like 'readFile2BL', but reads only first @n@ symbols specified with the second 'Int' argument dropping before this the first @m@ symbols specified 
-- with the first 'Int' argument.
readFile2BLMN :: Int -> Int -> FilePath -> IO (String)
readFile2BLMN :: Int -> Int -> String -> IO String
readFile2BLMN Int
m Int
n = Int -> Int -> String -> String -> IO String
readFile2BLGenMN Int
m Int
n []
{-# INLINE readFile2BLMN #-}

-- | After reading a file into a filtered lazy 'String' (see, 'readFile2BLGen') converts the resulting 'String' into a list
-- of 'Int'. The arguments have the same meaning as for 'readFile2BLGen'.
readFileDoublesGen :: String -> FilePath -> IO [Int]
readFileDoublesGen :: String -> String -> IO [Int]
readFileDoublesGen String
ys = (String -> [Int]) -> IO String -> IO [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [Int]
takeDoubles (String -> [Int]) -> (String -> String) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String -> String) -> String -> String
convH String
ys ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAsciiLower)) (IO String -> IO [Int])
-> (String -> IO String) -> String -> IO [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile

-- | Like 'readFileDoublesGen', but returns only first @n@ elements of the list specified with the first 'Int' argument.
readFileDoublesGenN :: Int -> String -> FilePath -> IO [Int]
readFileDoublesGenN :: Int -> String -> String -> IO [Int]
readFileDoublesGenN Int
n String
ys = (String -> [Int]) -> IO String -> IO [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ([Int] -> [Int]) -> (String -> [Int]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Int]
takeDoubles (String -> [Int]) -> (String -> String) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String -> String) -> String -> String
convH String
ys ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAsciiLower)) (IO String -> IO [Int])
-> (String -> IO String) -> String -> IO [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile

-- | Like 'readFileDoublesGen', but returns only first @n@ symbols specified with the second 'Int' argument dropping before this the first @m@ symbols specified 
-- with the first 'Int' argument.
readFileDoublesGenMN :: Int -> Int -> String -> FilePath -> IO [Int]
readFileDoublesGenMN :: Int -> Int -> String -> String -> IO [Int]
readFileDoublesGenMN Int
m Int
n String
ys = (String -> [Int]) -> IO String -> IO [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> [Int] -> [Int]
forall a. Eq a => Int -> Int -> [a] -> [a]
s2L (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m) (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) ([Int] -> [Int]) -> (String -> [Int]) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Int]
takeDoubles (String -> [Int]) -> (String -> String) -> String -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (String -> String) -> String -> String
convH String
ys ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAsciiLower)) (IO String -> IO [Int])
-> (String -> IO String) -> String -> IO [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO String
readFile

-- | Usual way the function 'readFileDoublesGen' is used. The text in a file being read is treated as a properly typed (entered) one. So there is no 
-- keyboard layout conversion at all.
readFileDoubles :: FilePath -> IO [Int]
readFileDoubles :: String -> IO [Int]
readFileDoubles = String -> String -> IO [Int]
readFileDoublesGen []
{-# INLINE readFileDoubles #-}

-- | Like 'readFileDoubles', but returns only first @n@ elements of the list specified with the first 'Int' argument.
readFileDoublesN :: Int -> FilePath -> IO [Int]
readFileDoublesN :: Int -> String -> IO [Int]
readFileDoublesN Int
n = Int -> String -> String -> IO [Int]
readFileDoublesGenN Int
n []
{-# INLINE readFileDoublesN #-}

-- | Like 'readFileDoubles', but returns only first @n@ elements of the list specified with the second 'Int' argument 
-- dropping before this the first @m@ elements specified with the first 'Int' argument.
readFileDoublesMN :: Int -> Int -> FilePath -> IO [Int]
readFileDoublesMN :: Int -> Int -> String -> IO [Int]
readFileDoublesMN Int
m Int
n = Int -> Int -> String -> String -> IO [Int]
readFileDoublesGenMN Int
m Int
n []
{-# INLINE readFileDoublesMN #-}