Merge pull request #19 from haskell-works/safe-and-unsafe-functions

Safe and unsafe functions

Author: newhoggy

Diff for: app/App/Commands/Capabilities.hs

@@ -4,21 +4,21 @@ module App.Commands.Capabilities
   ( cmdCapabilities
   ) where
 
-import Data.Semigroup      ((<>))
-import Options.Applicative hiding (columns)
+import Data.Semigroup                             ((<>))
+import HaskellWorks.Data.Json.Simd.Index.Simple
+import HaskellWorks.Data.Json.Simd.Index.Standard
+import Options.Applicative                        hiding (columns)
 
-import qualified HaskellWorks.Data.Json.Simd.Index.Simple   as SIMPLE
-import qualified HaskellWorks.Data.Json.Simd.Index.Standard as STANDARD
-import qualified System.IO                                  as IO
+import qualified System.IO as IO
 
 {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}
 {-# ANN module ("HLint: ignore Redundant do"        :: String) #-}
 
 runCapabilities :: () -> IO ()
 runCapabilities opts = do
   IO.putStrLn "Capabalities:"
-  IO.putStrLn $ "  standard indexing: " <> show STANDARD.enabled
-  IO.putStrLn $ "  simple indexing: "   <> show SIMPLE.enabled
+  IO.putStrLn $ "  standard indexing: " <> show enabledMakeStandardJsonIbBps
+  IO.putStrLn $ "  simple indexing: "   <> show enabledMakeSimpleJsonIbBps
 
 optsCapabilities :: Parser ()
 optsCapabilities = pure ()

Diff for: app/App/Commands/CreateIndex.hs

@@ -8,17 +8,17 @@ import App.Commands.Types
 import Control.Lens
 import Control.Monad
 import Data.Maybe
-import Data.Semigroup      ((<>))
-import Options.Applicative hiding (columns)
+import Data.Semigroup                             ((<>))
+import HaskellWorks.Data.Json.Simd.Index.Simple
+import HaskellWorks.Data.Json.Simd.Index.Standard
+import Options.Applicative                        hiding (columns)
 
-import qualified App.Lens                                   as L
-import qualified Data.ByteString                            as BS
-import qualified Data.ByteString.Lazy                       as LBS
-import qualified HaskellWorks.Data.ByteString.Lazy          as LBS
-import qualified HaskellWorks.Data.Json.Simd.Index.Simple   as SIMPLE
-import qualified HaskellWorks.Data.Json.Simd.Index.Standard as STANDARD
-import qualified System.Exit                                as IO
-import qualified System.IO                                  as IO
+import qualified App.Lens                          as L
+import qualified Data.ByteString                   as BS
+import qualified Data.ByteString.Lazy              as LBS
+import qualified HaskellWorks.Data.ByteString.Lazy as LBS
+import qualified System.Exit                       as IO
+import qualified System.IO                         as IO
 
 {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}
 {-# ANN module ("HLint: ignore Redundant do"        :: String) #-}
@@ -34,7 +34,7 @@ runCreateIndex opts = do
     "simple" -> do
       IO.withFile filePath IO.ReadMode $ \hIn -> do
         contents <- LBS.resegmentPadded 512 <$> LBS.hGetContents hIn
-        let chunks = SIMPLE.makeIbBps contents
+        let chunks = makeSimpleJsonIbBpsUnsafe contents
         IO.withFile outputIbFile IO.WriteMode $ \hIb -> do
           IO.withFile outputBpFile IO.WriteMode $ \hBp -> do
             forM_ chunks $ \(ibBs, bpBs) -> do
@@ -43,7 +43,7 @@ runCreateIndex opts = do
     "standard" -> do
       IO.withFile filePath IO.ReadMode $ \hIn -> do
         contents <- LBS.resegmentPadded 512 <$> LBS.hGetContents hIn
-        let chunks = STANDARD.makeIbBps contents
+        let chunks = makeStandardJsonIbBpsUnsafe contents
         IO.withFile outputIbFile IO.WriteMode $ \hIb -> do
           IO.withFile outputBpFile IO.WriteMode $ \hBp -> do
             forM_ chunks $ \(ibBs, bpBs) -> do

Diff for: src/HaskellWorks/Data/Json/Simd/Index/Simple.hs

@@ -2,8 +2,9 @@
 {-# LANGUAGE RankNTypes #-}
 
 module HaskellWorks.Data.Json.Simd.Index.Simple
-  ( makeIbBps
-  , enabled
+  ( makeSimpleJsonIbBps
+  , makeSimpleJsonIbBpsUnsafe
+  , enabledMakeSimpleJsonIbBps
   ) where
 
 import Control.Monad.ST
@@ -27,8 +28,13 @@ import qualified System.IO.Unsafe                             as IO
 {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}
 {-# ANN module ("HLint: ignore Redundant do"        :: String) #-}
 
-makeIbBps :: LBS.ByteString -> [(BS.ByteString, BS.ByteString)]
-makeIbBps lbs = L.zipPadded BS.empty BS.empty ibs bps
+makeSimpleJsonIbBps :: LBS.ByteString -> Either String [(BS.ByteString, BS.ByteString)]
+makeSimpleJsonIbBps lbs = if enabledMakeSimpleJsonIbBps
+  then Right (makeSimpleJsonIbBpsUnsafe lbs)
+  else Left "makeSimpleJsonIbBps function is disabled"
+
+makeSimpleJsonIbBpsUnsafe :: LBS.ByteString -> [(BS.ByteString, BS.ByteString)]
+makeSimpleJsonIbBpsUnsafe lbs = L.zipPadded BS.empty BS.empty ibs bps
   where chunks  = makeIbs lbs
         ibs     = fmap (\(a, _, _) -> a) chunks
         bps     = ibsToIndexByteStrings chunks
@@ -138,5 +144,5 @@ stepToByteString state (Step step size) = F.unsafeLocalState $ do
   w64Size <- stToIO $ step state bpVm
   return (BSI.PS bpFptr 0 (w64Size * 8))
 
-enabled :: Bool
-enabled = C.avx_2 && C.sse_4_2 && C.bmi_2
+enabledMakeSimpleJsonIbBps :: Bool
+enabledMakeSimpleJsonIbBps = C.avx_2 && C.sse_4_2 && C.bmi_2

Diff for: src/HaskellWorks/Data/Json/Simd/Index/Standard.hs

@@ -4,8 +4,9 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module HaskellWorks.Data.Json.Simd.Index.Standard
-  ( makeIbBps
-  , enabled
+  ( makeStandardJsonIbBps
+  , makeStandardJsonIbBpsUnsafe
+  , enabledMakeStandardJsonIbBps
   ) where
 
 import Control.Monad
@@ -27,8 +28,13 @@ import qualified System.IO.Unsafe                             as IO
 {-# ANN module ("HLint: ignore Reduce duplication"  :: String) #-}
 {-# ANN module ("HLint: ignore Redundant do"        :: String) #-}
 
-makeIbBps :: LBS.ByteString -> [(BS.ByteString, BS.ByteString)]
-makeIbBps lbs = F.unsafeLocalState $ do
+makeStandardJsonIbBps :: LBS.ByteString -> Either String [(BS.ByteString, BS.ByteString)]
+makeStandardJsonIbBps lbs = if enabledMakeStandardJsonIbBps
+  then Right (makeStandardJsonIbBpsUnsafe lbs)
+  else Left "makeStandardJsonIbBps function is disabled"
+
+makeStandardJsonIbBpsUnsafe :: LBS.ByteString -> [(BS.ByteString, BS.ByteString)]
+makeStandardJsonIbBpsUnsafe lbs = F.unsafeLocalState $ do
   wb <- allocWorkBuffers (32 * 1024 * 1204)
   ws <- newWorkState 0
   fptrState       :: F.ForeignPtr F.UInt32  <- F.mallocForeignPtr
@@ -102,5 +108,5 @@ makeIbBps lbs = F.unsafeLocalState $ do
           rs <- IO.unsafeInterleaveIO $ go wb ws fptrState fptrRemBits fptrRemBitsLen bss
           return (r:rs)
 
-enabled :: Bool
-enabled = C.avx_2 && C.sse_4_2 && C.bmi_2
+enabledMakeStandardJsonIbBps :: Bool
+enabledMakeStandardJsonIbBps = C.avx_2 && C.sse_4_2 && C.bmi_2