-- |
-- Module      :  DobutokO.Sound.Keyboard
-- Copyright   :  (c) OleksandrZhabenko 2020, 2024
-- License     :  MIT
-- Stability   :  Experimental
-- Maintainer  :  oleksandr.zhabenko@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 DobutokO.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 GHC.Arr
import CaseBi.Arr (getBFst')
import Data.Char (isAsciiLower)
import qualified Data.Vector as V
import GHC.Int (Int64)
import qualified Data.ByteString.Lazy.Char8 as BL (ByteString,map,zipWith,tail,filter,getContents,readFile,take,drop)

-- | Converts a lazy 'BL.ByteString' into a 'V.Vector' of 'Int' using 'hashStr2'. 
takeDoubles :: BL.ByteString -> V.Vector Int
takeDoubles :: ByteString -> Vector Int
takeDoubles ByteString
xs = [Int] -> Vector Int
forall a. [a] -> Vector a
V.fromList ([Int] -> Vector Int)
-> (ByteString -> [Int]) -> ByteString -> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Int) -> ByteString -> ByteString -> [Int]
forall a. (Char -> Char -> a) -> ByteString -> ByteString -> [a]
BL.zipWith Char -> Char -> Int
hashStr2 ByteString
xs (ByteString -> Vector Int) -> ByteString -> Vector Int
forall a b. (a -> b) -> a -> b
$ HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BL.tail ByteString
xs

-- | Converts a string of lowercase ASCII letters being typed on the QWERTY keyboard layout into corresponding Dvorak keyboard layout.
qwerty2dvorak :: BL.ByteString -> BL.ByteString
qwerty2dvorak :: ByteString -> ByteString
qwerty2dvorak = (Char -> Char) -> ByteString -> ByteString
BL.map ((Char, Array Int (Char, Char)) -> Char -> Char
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Char
' ',(Int, Int) -> [(Char, Char)] -> Array Int (Char, Char)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
29) ([(Char, Char)] -> Array Int (Char, Char))
-> (String -> [(Char, Char)]) -> String -> Array Int (Char, Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Array Int (Char, Char))
-> String -> Array Int (Char, Char)
forall a b. (a -> b) -> a -> b
$ String
"wvszaxje.uidchtnmbrl'poygk,qf;"))

-- | Vice versa to 'qwerty2dvorak'.
dvorak2qwerty :: BL.ByteString -> BL.ByteString
dvorak2qwerty :: ByteString -> ByteString
dvorak2qwerty = (Char -> Char) -> ByteString -> ByteString
BL.map ((Char, Array Int (Char, Char)) -> Char -> Char
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Char
' ',(Int, Int) -> [(Char, Char)] -> Array Int (Char, Char)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
29) ([(Char, Char)] -> Array Int (Char, Char))
-> (String -> [(Char, Char)]) -> String -> Array Int (Char, Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Array Int (Char, Char))
-> String -> Array Int (Char, Char)
forall a b. (a -> b) -> a -> b
$ 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, Array Int (Char, Int)) -> Char -> Int
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (Int
57, (Int, Int) -> [(Char, Int)] -> Array Int (Char, Int)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
25) ([(Char, Int)] -> Array Int (Char, Int))
-> ([[Int]] -> [(Char, Int)]) -> [[Int]] -> Array Int (Char, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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, Array Int (Char, Int)) -> Char -> Int
forall a b. Ord a => (b, Array Int (a, b)) -> a -> b
getBFst' (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, (Int, Int) -> [(Char, Int)] -> Array Int (Char, Int)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
25) ([(Char, Int)] -> Array Int (Char, Int))
-> ([Int] -> [(Char, Int)]) -> [Int] -> Array Int (Char, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Char
'a'..Char
'z'] ([Int] -> Array Int (Char, Int)) -> [Int] -> Array Int (Char, Int)
forall a b. (a -> b) -> a -> b
$ [(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]] -> Array Int (Char, Int))
-> [[Int]] -> Array 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 'BL.ByteString' with filtering of all characters that are not a lower case ascii letters.
input2BL :: IO (BL.ByteString)
input2BL :: IO ByteString
input2BL = (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> (ByteString -> ByteString) -> ByteString -> ByteString
convH [] ((Char -> Bool) -> ByteString -> ByteString
BL.filter Char -> Bool
isAsciiLower)) IO ByteString
BL.getContents

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

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

-- | Reads a given file into a lazy 'BL.ByteString' 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 (BL.ByteString)
readFile2BLGen :: String -> String -> IO ByteString
readFile2BLGen String
ys = (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> (ByteString -> ByteString) -> ByteString -> ByteString
convH String
ys ((Char -> Bool) -> ByteString -> ByteString
BL.filter Char -> Bool
isAsciiLower)) (IO ByteString -> IO ByteString)
-> (String -> IO ByteString) -> String -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
BL.readFile

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

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

-- | Auxiliary function to define how is a 'BL.ByteString' treated, see 'readFile2BLGen'.
convH :: String -> (BL.ByteString -> BL.ByteString) -> (BL.ByteString -> BL.ByteString)
convH :: String -> (ByteString -> ByteString) -> ByteString -> ByteString
convH String
ys ByteString -> ByteString
f 
 | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys = ByteString -> ByteString
f
 | String
ys String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"q" = ByteString -> ByteString
qwerty2dvorak (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
f
 | Bool
otherwise = ByteString -> ByteString
dvorak2qwerty (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
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 (BL.ByteString)
readFile2BL :: String -> IO ByteString
readFile2BL = String -> String -> IO ByteString
readFile2BLGen []

-- | Like 'readFile2BL', but reads only first @n@ symbols specified with the first 'Int64' argument.
readFile2BLN :: Int64 -> FilePath -> IO (BL.ByteString)
readFile2BLN :: Int64 -> String -> IO ByteString
readFile2BLN Int64
n = Int64 -> String -> String -> IO ByteString
readFile2BLGenN Int64
n []

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

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

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

-- | Like 'readFileDoublesGen', but returns only first @n@ symbols specified with the second 'Int64' argument dropping before this the first @m@ symbols specified 
-- with the first 'Int64' argument.
readFileDoublesGenMN :: Int64 -> Int64 -> String -> FilePath -> IO (V.Vector Int)
readFileDoublesGenMN :: Int64 -> Int64 -> String -> String -> IO (Vector Int)
readFileDoublesGenMN Int64
m Int64
n String
ys = (ByteString -> Vector Int) -> IO ByteString -> IO (Vector Int)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Vector Int -> Vector Int
forall a. Int -> Int -> Vector a -> Vector a
V.unsafeSlice (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
m) (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) (Vector Int -> Vector Int)
-> (ByteString -> Vector Int) -> ByteString -> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Vector Int
takeDoubles (ByteString -> Vector Int)
-> (ByteString -> ByteString) -> ByteString -> Vector Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (ByteString -> ByteString) -> ByteString -> ByteString
convH String
ys ((Char -> Bool) -> ByteString -> ByteString
BL.filter Char -> Bool
isAsciiLower)) (IO ByteString -> IO (Vector Int))
-> (String -> IO ByteString) -> String -> IO (Vector Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ByteString
BL.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 (V.Vector Int)
readFileDoubles :: String -> IO (Vector Int)
readFileDoubles = String -> String -> IO (Vector Int)
readFileDoublesGen []

-- | Like 'readFileDoubles', but returns only first @n@ elements of the 'V.Vector' specified with the first 'Int64' argument.
readFileDoublesN :: Int64 -> FilePath -> IO (V.Vector Int)
readFileDoublesN :: Int64 -> String -> IO (Vector Int)
readFileDoublesN Int64
n = Int64 -> String -> String -> IO (Vector Int)
readFileDoublesGenN Int64
n []

-- | Like 'readFileDoubles', but returns only first @n@ elements of the 'V.Vector' specified with the second 'Int64' argument 
-- dropping before this the first @m@ elements specified with the first 'Int64' argument.
readFileDoublesMN :: Int64 -> Int64 -> FilePath -> IO (V.Vector Int)
readFileDoublesMN :: Int64 -> Int64 -> String -> IO (Vector Int)
readFileDoublesMN Int64
m Int64
n = Int64 -> Int64 -> String -> String -> IO (Vector Int)
readFileDoublesGenMN Int64
m Int64
n []