-- |
-- 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)
import qualified Data.ByteString.Lazy.Char8 as BL (ByteString,map,zipWith,tail,filter,getContents,readFile,take,drop)

-- | Converts a lazy 'BL.ByteString' into a list of 'Int' using 'hashStr2'. 
takeDoubles :: BL.ByteString -> [Int]
takeDoubles :: ByteString -> [Int]
takeDoubles ByteString
xs = (Char -> Char -> Int) -> ByteString -> ByteString -> [Int]
forall a. (Char -> Char -> a) -> ByteString -> ByteString -> [a]
BL.zipWith Char -> Char -> Int
hashStr2 ByteString
xs (ByteString -> [Int]) -> ByteString -> [Int]
forall a b. (a -> b) -> a -> b
$ 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 -> [(Char, Char)] -> Char -> Char
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' Char
' ' ([Char] -> [Char] -> [(Char, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Char]
"/;<>" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'a'..Char
'z']) [Char]
"wvszaxje.uidchtnmbrl'poygk,qf;"))

-- | Vice versa to 'qwerty2dvorak'.
dvorak2qwerty :: BL.ByteString -> BL.ByteString
dvorak2qwerty :: ByteString -> ByteString
dvorak2qwerty = (Char -> Char) -> ByteString -> ByteString
BL.map (Char -> [(Char, Char)] -> Char -> Char
forall a b. Ord a => b -> [(a, b)] -> a -> b
getBFstL' Char
' ' ([Char] -> [Char] -> [(Char, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Char]
"',.;" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'a'..Char
'z']) [Char]
"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 ([Char] -> [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) ([Char] -> [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 '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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> (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 :: [Char] -> [Char] -> IO ByteString
readFile2BLGen [Char]
ys = (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> (ByteString -> ByteString) -> ByteString -> ByteString
convH [Char]
ys ((Char -> Bool) -> ByteString -> ByteString
BL.filter Char -> Bool
isAsciiLower)) (IO ByteString -> IO ByteString)
-> ([Char] -> IO ByteString) -> [Char] -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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 -> [Char] -> [Char] -> IO ByteString
readFile2BLGenN Int64
n [Char]
ys = (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> (ByteString -> ByteString) -> ByteString -> ByteString
convH [Char]
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)
-> ([Char] -> IO ByteString) -> [Char] -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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 -> [Char] -> [Char] -> IO ByteString
readFile2BLGenMN Int64
m Int64
n [Char]
ys = (ByteString -> ByteString) -> IO ByteString -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Char] -> (ByteString -> ByteString) -> ByteString -> ByteString
convH [Char]
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)
-> ([Char] -> IO ByteString) -> [Char] -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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 :: [Char] -> (ByteString -> ByteString) -> ByteString -> ByteString
convH [Char]
ys ByteString -> ByteString
f 
 | [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
ys = ByteString -> ByteString
f
 | [Char]
ys [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"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 :: [Char] -> IO ByteString
readFile2BL = [Char] -> [Char] -> IO ByteString
readFile2BLGen []
{-# INLINE readFile2BL #-}

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

-- | 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 -> [Char] -> IO ByteString
readFile2BLMN Int64
m Int64
n = Int64 -> Int64 -> [Char] -> [Char] -> IO ByteString
readFile2BLGenMN Int64
m Int64
n []
{-# INLINE readFile2BLMN #-}

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

-- | Like 'readFileDoublesGen', but returns only first @n@ elements of the list specified with the first 'Int64' argument.
readFileDoublesGenN :: Int64 -> String -> FilePath -> IO [Int]
readFileDoublesGenN :: Int64 -> [Char] -> [Char] -> IO [Int]
readFileDoublesGenN Int64
n [Char]
ys = (ByteString -> [Int]) -> IO ByteString -> IO [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
take (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n) ([Int] -> [Int]) -> (ByteString -> [Int]) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Int]
takeDoubles (ByteString -> [Int])
-> (ByteString -> ByteString) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> (ByteString -> ByteString) -> ByteString -> ByteString
convH [Char]
ys ((Char -> Bool) -> ByteString -> ByteString
BL.filter Char -> Bool
isAsciiLower)) (IO ByteString -> IO [Int])
-> ([Char] -> IO ByteString) -> [Char] -> IO [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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 [Int]
readFileDoublesGenMN :: Int64 -> Int64 -> [Char] -> [Char] -> IO [Int]
readFileDoublesGenMN Int64
m Int64
n [Char]
ys = (ByteString -> [Int]) -> IO ByteString -> 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 (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) ([Int] -> [Int]) -> (ByteString -> [Int]) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Int]
takeDoubles (ByteString -> [Int])
-> (ByteString -> ByteString) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> (ByteString -> ByteString) -> ByteString -> ByteString
convH [Char]
ys ((Char -> Bool) -> ByteString -> ByteString
BL.filter Char -> Bool
isAsciiLower)) (IO ByteString -> IO [Int])
-> ([Char] -> IO ByteString) -> [Char] -> IO [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> 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 [Int]
readFileDoubles :: [Char] -> IO [Int]
readFileDoubles = [Char] -> [Char] -> IO [Int]
readFileDoublesGen []
{-# INLINE readFileDoubles #-}

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

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