{-# LINE 1 "src/Cut/SpeechRecognition.chs" #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DeriveAnyClass #-}
module Cut.SpeechRecognition(speechAnalyses
, frame_from
, frame_to
, frame_word
, FrameOffset
, WordFrame
, ResultCode(..)
, toDiffTime
, toFrameOffset
, noOffset
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp
import Data.Time
import GHC.Generics
import Data.Text(Text)
import qualified Data.Text as Text
import Foreign
import Foreign.C
import Control.Lens
import Data.Generics.Product.Fields
data ResultCode = Success
| FailedConfigObject
| FailedCreateRecognizer
| FailedUnableInputfile
deriving (Int -> ResultCode
ResultCode -> Int
ResultCode -> [ResultCode]
ResultCode -> ResultCode
ResultCode -> ResultCode -> [ResultCode]
ResultCode -> ResultCode -> ResultCode -> [ResultCode]
(ResultCode -> ResultCode)
-> (ResultCode -> ResultCode)
-> (Int -> ResultCode)
-> (ResultCode -> Int)
-> (ResultCode -> [ResultCode])
-> (ResultCode -> ResultCode -> [ResultCode])
-> (ResultCode -> ResultCode -> [ResultCode])
-> (ResultCode -> ResultCode -> ResultCode -> [ResultCode])
-> Enum ResultCode
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ResultCode -> ResultCode -> ResultCode -> [ResultCode]
$cenumFromThenTo :: ResultCode -> ResultCode -> ResultCode -> [ResultCode]
enumFromTo :: ResultCode -> ResultCode -> [ResultCode]
$cenumFromTo :: ResultCode -> ResultCode -> [ResultCode]
enumFromThen :: ResultCode -> ResultCode -> [ResultCode]
$cenumFromThen :: ResultCode -> ResultCode -> [ResultCode]
enumFrom :: ResultCode -> [ResultCode]
$cenumFrom :: ResultCode -> [ResultCode]
fromEnum :: ResultCode -> Int
$cfromEnum :: ResultCode -> Int
toEnum :: Int -> ResultCode
$ctoEnum :: Int -> ResultCode
pred :: ResultCode -> ResultCode
$cpred :: ResultCode -> ResultCode
succ :: ResultCode -> ResultCode
$csucc :: ResultCode -> ResultCode
Enum)
{-# LINE 31 "src/Cut/SpeechRecognition.chs" #-}
deriving instance Show ResultCode
newtype FrameOffset = FrameOffset Int
deriving (Generic, Show)
noOffset :: FrameOffset
noOffset = FrameOffset 0
toFrameOffset :: Int -> FrameOffset
toFrameOffset = FrameOffset
data WordFrame = WordFrame
{ WordFrame -> FrameOffset
_frame_from :: FrameOffset
, WordFrame -> FrameOffset
_frame_to :: FrameOffset
, WordFrame -> Text
_frame_word :: Text
} deriving ((forall x. WordFrame -> Rep WordFrame x)
-> (forall x. Rep WordFrame x -> WordFrame) -> Generic WordFrame
forall x. Rep WordFrame x -> WordFrame
forall x. WordFrame -> Rep WordFrame x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WordFrame x -> WordFrame
$cfrom :: forall x. WordFrame -> Rep WordFrame x
Generic, Int -> WordFrame -> ShowS
[WordFrame] -> ShowS
WordFrame -> String
(Int -> WordFrame -> ShowS)
-> (WordFrame -> String)
-> ([WordFrame] -> ShowS)
-> Show WordFrame
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordFrame] -> ShowS
$cshowList :: [WordFrame] -> ShowS
show :: WordFrame -> String
$cshow :: WordFrame -> String
showsPrec :: Int -> WordFrame -> ShowS
$cshowsPrec :: Int -> WordFrame -> ShowS
Show)
instance Storable WordFrame where
alignment :: WordFrame -> Int
alignment _ = 4
sizeOf :: WordFrame -> Int
sizeOf _ = 16
peek :: Ptr WordFrame -> IO WordFrame
peek ptr :: Ptr WordFrame
ptr =
FrameOffset -> FrameOffset -> Text -> WordFrame
WordFrame
(FrameOffset -> FrameOffset -> Text -> WordFrame)
-> IO FrameOffset -> IO (FrameOffset -> Text -> WordFrame)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> FrameOffset
FrameOffset (Int -> FrameOffset) -> (CInt -> Int) -> CInt -> FrameOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
toInt (CInt -> FrameOffset) -> IO CInt -> IO FrameOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr WordFrame -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr WordFrame
ptr 0)
IO (FrameOffset -> Text -> WordFrame)
-> IO FrameOffset -> IO (Text -> WordFrame)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> FrameOffset
FrameOffset (Int -> FrameOffset) -> (CInt -> Int) -> CInt -> FrameOffset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
toInt (CInt -> FrameOffset) -> IO CInt -> IO FrameOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr WordFrame -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr WordFrame
ptr 4)
IO (Text -> WordFrame) -> IO Text -> IO WordFrame
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr WordFrame -> Int -> IO CString
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr WordFrame
ptr 8 IO CString -> (CString -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> Text) -> IO String -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack (IO String -> IO Text)
-> (CString -> IO String) -> CString -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO String
peekCString)
poke :: Ptr WordFrame -> WordFrame -> IO ()
poke ptr :: Ptr WordFrame
ptr (WordFrame (FrameOffset d :: Int
d) (FrameOffset c :: Int
c) i :: Text
i) = do
Ptr WordFrame -> Int -> Int -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr WordFrame
ptr 0 Int
d
Ptr WordFrame -> Int -> Int -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr WordFrame
ptr 4 Int
c
String -> (CString -> IO ()) -> IO ()
forall a. String -> (CString -> IO a) -> IO a
withCString (Text -> String
Text.unpack Text
i) ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr WordFrame -> Int -> CString -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr WordFrame
ptr 8
frame_from :: Lens' WordFrame FrameOffset
frame_from :: (FrameOffset -> f FrameOffset) -> WordFrame -> f WordFrame
frame_from = forall s t a b. HasField "_frame_from" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"_frame_from"
frame_to :: Lens' WordFrame FrameOffset
frame_to :: (FrameOffset -> f FrameOffset) -> WordFrame -> f WordFrame
frame_to = forall s t a b. HasField "_frame_to" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"_frame_to"
toDiffTime :: FrameOffset -> FrameOffset -> DiffTime
toDiffTime :: FrameOffset -> FrameOffset -> DiffTime
toDiffTime (FrameOffset startoffset :: Int
startoffset) (FrameOffset x :: Int
x) =
Integer -> DiffTime
secondsToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startoffset) 45
frame_word :: Lens' WordFrame Text
frame_word :: (Text -> f Text) -> WordFrame -> f WordFrame
frame_word = forall s t a b. HasField "_frame_word" s t a b => Lens s t a b
forall (field :: Symbol) s t a b.
HasField field s t a b =>
Lens s t a b
field @"_frame_word"
toInt :: CInt -> Int
toInt :: CInt -> Int
toInt = Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (CInt -> Integer) -> CInt -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Integer
forall a. Integral a => a -> Integer
toInteger
detectedToList :: CInt -> Ptr WordFrame -> IO [WordFrame]
detectedToList :: CInt -> Ptr WordFrame -> IO [WordFrame]
detectedToList c_used :: CInt
c_used frames :: Ptr WordFrame
frames =
(Int -> IO WordFrame) -> [Int] -> IO [WordFrame]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Ptr WordFrame -> IO WordFrame
forall a. Storable a => Ptr a -> IO a
peek (Ptr WordFrame -> IO WordFrame)
-> (Int -> Ptr WordFrame) -> Int -> IO WordFrame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr WordFrame -> Int -> Ptr WordFrame
forall a b. Ptr a -> Int -> Ptr b
plusPtr Ptr WordFrame
frames (Int -> Ptr WordFrame) -> (Int -> Int) -> Int -> Ptr WordFrame
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) (WordFrame -> Int
forall a. Storable a => a -> Int
sizeOf (WordFrame
forall a. HasCallStack => a
undefined :: WordFrame)) ) [0..(Int
used Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)]
where
used :: Int
used = CInt -> Int
toInt CInt
c_used
speechAnalyses :: FilePath -> IO (Either ResultCode [WordFrame])
speechAnalyses :: String -> IO (Either ResultCode [WordFrame])
speechAnalyses filePath :: String
filePath = do
Ptr ()
c_result <- String -> (CString -> IO (Ptr ())) -> IO (Ptr ())
forall a. String -> (CString -> IO a) -> IO a
withCString String
filePath CString -> IO (Ptr ())
detect_words_ffi
Ptr WordFrame
c_words <- Ptr () -> Int -> IO (Ptr WordFrame)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
c_result 8
CInt
c_words_used <- Ptr () -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr ()
c_result 16
ResultCode
status_code <- Int -> ResultCode
forall a. Enum a => Int -> a
toEnum (Int -> ResultCode) -> (CInt -> Int) -> CInt -> ResultCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> ResultCode) -> IO CInt -> IO ResultCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (\ptr :: Ptr ()
ptr -> do {Ptr () -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr 0 :: IO C2HSImp.CInt}) Ptr ()
c_result
case ResultCode
status_code of
Success -> [WordFrame] -> Either ResultCode [WordFrame]
forall a b. b -> Either a b
Right ([WordFrame] -> Either ResultCode [WordFrame])
-> IO [WordFrame] -> IO (Either ResultCode [WordFrame])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CInt -> Ptr WordFrame -> IO [WordFrame]
detectedToList CInt
c_words_used Ptr WordFrame
c_words
x :: ResultCode
x -> Either ResultCode [WordFrame] -> IO (Either ResultCode [WordFrame])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResultCode [WordFrame]
-> IO (Either ResultCode [WordFrame]))
-> Either ResultCode [WordFrame]
-> IO (Either ResultCode [WordFrame])
forall a b. (a -> b) -> a -> b
$ ResultCode -> Either ResultCode [WordFrame]
forall a b. a -> Either a b
Left ResultCode
x
foreign import ccall "detect_words" detect_words_ffi :: CString -> IO (((C2HSImp.Ptr ())))