Updates to Haskell bindings (#253)

* [haskell] Style fixes

No changes to functionality

* [haskell] Updated `assemble` function

assemble now takes a list of strings, rather than a single semicolon or newline -delimited string. This is more "Haskell-ish".

* [haskell] More style fixes

bindings/haskell/README.md

@@ -3,7 +3,7 @@ source.
 
 1. Install the core Keystone Assembler as a dependency:
 
-    Follow docs/COMPILE.md in the root directory to compile & install the core.
+   Follow docs/COMPILE.md in the root directory to compile & install the core.
 2. Change into the Haskell bindings directory, build and install:
 
     ```

bindings/haskell/keystone.cabal

@@ -10,7 +10,7 @@ license:             GPL-2
 author:              Adrian Herrera
 category:            System
 build-type:          Simple
-cabal-version:       >=1.10
+cabal-version:       >= 1.10
 
 library
   exposed-modules:     Keystone.Internal.Core
@@ -25,10 +25,10 @@ library
                        Keystone.CPU.X86
                        Keystone
   other-modules:       Keystone.Internal.Util
-  build-depends:       base >= 4 && < 5,
-                       bytestring >= 0.9.1,
-                       transformers < 0.6,
-                       either >= 4.4
+  build-depends:         base >= 4 && < 5
+                       , bytestring >= 0.9.1
+                       , transformers < 0.6
+                       , either >= 4.4
   hs-source-dirs:      src
   c-sources:           src/cbits/keystone_wrapper.c
   include-dirs:        src/include

bindings/haskell/samples/Sample.hs

--- Sample code for Keystone Assembler Engine
+-- Sample code for Keystone Assembler Engine.
 
 import Keystone
 
 import qualified Data.ByteString as BS
+import Data.List (intercalate)
 import qualified Numeric as N (showHex)
 
--- Pretty-print byte string as hex
-showHexBS :: BS.ByteString -> String
+-- Pretty-print byte string as hex.
+showHexBS :: BS.ByteString
+          -> String
 showHexBS =
     concatMap (flip N.showHex " ") . BS.unpack
 
 testKs :: Architecture
        -> [Mode]
-       -> String
+       -> [String]
        -> Maybe OptionValue
        -> IO ()
 testKs arch mode assembly maybeSyntax = do
@@ -25,7 +27,7 @@ testKs arch mode assembly maybeSyntax = do
         return (encode, count)
     case result of
         Right (encode, count) -> let size = BS.length encode in do
-            putStr $ assembly ++ " = "
+            putStr   $ intercalate ";" assembly ++ " = "
             putStrLn $ showHexBS encode
             putStrLn $ "Assembled: " ++ show size ++ " bytes, " ++
                        show count ++ " statements\n"
@@ -35,38 +37,38 @@ testKs arch mode assembly maybeSyntax = do
 main :: IO ()
 main = do
     -- X86
-    testKs ArchX86 [Mode16] "add eax, ecx" Nothing
-    testKs ArchX86 [Mode32] "add eax, ecx" Nothing
-    testKs ArchX86 [Mode64] "add rax, rcx" Nothing
-    testKs ArchX86 [Mode32] "add %ecx, %eax" (Just SyntaxAtt)
-    testKs ArchX86 [Mode64] "add %rcx, %rax" (Just SyntaxAtt)
+    testKs ArchX86 [Mode16] ["add eax, ecx"]   Nothing
+    testKs ArchX86 [Mode32] ["add eax, ecx"]   Nothing
+    testKs ArchX86 [Mode64] ["add rax, rcx"]   Nothing
+    testKs ArchX86 [Mode32] ["add %ecx, %eax"] (Just SyntaxAtt)
+    testKs ArchX86 [Mode64] ["add %rcx, %rax"] (Just SyntaxAtt)
 
     -- ARM
-    testKs ArchArm [ModeArm] "sub r1, r2, r5" Nothing
-    testKs ArchArm [ModeArm, ModeBigEndian] "sub r1, r2, r5" Nothing
-    testKs ArchArm [ModeThumb] "movs r4, #0xf0" Nothing
-    testKs ArchArm [ModeThumb, ModeBigEndian] "movs r4, #0xf0" Nothing
+    testKs ArchArm [ModeArm]                ["sub r1, r2, r5"]   Nothing
+    testKs ArchArm [ModeArm, ModeBigEndian] ["sub r1, r2, r5"]   Nothing
+    testKs ArchArm [ModeThumb]              ["movs r4, #0xf0"]   Nothing
+    testKs ArchArm [ModeThumb, ModeBigEndian] ["movs r4, #0xf0"] Nothing
 
     -- ARM64
-    testKs ArchArm64 [ModeLittleEndian] "ldr w1, [sp, #0x8]" Nothing
+    testKs ArchArm64 [ModeLittleEndian] ["ldr w1, [sp, #0x8]"] Nothing
 
     -- Hexagon
-    testKs ArchHexagon [ModeBigEndian] "v23.w=vavg(v11.w,v2.w):rnd" Nothing
+    testKs ArchHexagon [ModeBigEndian] ["v23.w=vavg(v11.w,v2.w):rnd"] Nothing
 
     -- MIPS
-    testKs ArchMips [ModeMips32] "and $9, $6, $7" Nothing
-    testKs ArchMips [ModeMips32, ModeBigEndian] "and $9, $6, $7" Nothing
-    testKs ArchMips [ModeMips64] "and $9, $6, $7" Nothing
-    testKs ArchMips [ModeMips64, ModeBigEndian] "and $9, $6, $7" Nothing
+    testKs ArchMips [ModeMips32]                ["and $9, $6, $7"] Nothing
+    testKs ArchMips [ModeMips32, ModeBigEndian] ["and $9, $6, $7"] Nothing
+    testKs ArchMips [ModeMips64]                ["and $9, $6, $7"] Nothing
+    testKs ArchMips [ModeMips64, ModeBigEndian] ["and $9, $6, $7"] Nothing
 
     -- PowerPC
-    testKs ArchPpc [ModePpc32, ModeBigEndian] "add 1, 2, 3" Nothing
-    testKs ArchPpc [ModePpc64] "add 1, 2, 3" Nothing
-    testKs ArchPpc [ModePpc64, ModeBigEndian] "add 1, 2, 3" Nothing
+    testKs ArchPpc [ModePpc32, ModeBigEndian] ["add 1, 2, 3"] Nothing
+    testKs ArchPpc [ModePpc64]                ["add 1, 2, 3"] Nothing
+    testKs ArchPpc [ModePpc64, ModeBigEndian] ["add 1, 2, 3"] Nothing
 
     -- SPARC
-    testKs ArchSparc [ModeSparc32, ModeLittleEndian] "add %g1, %g2, %g3" Nothing
-    testKs ArchSparc [ModeSparc32, ModeBigEndian] "add %g1, %g2, %g3" Nothing
+    testKs ArchSparc [ModeSparc32, ModeLittleEndian] ["add %g1, %g2, %g3"] Nothing
+    testKs ArchSparc [ModeSparc32, ModeBigEndian]    ["add %g1, %g2, %g3"] Nothing
 
     -- SystemZ
-    testKs ArchSystemz [ModeBigEndian] "a %r0, 4095(%r15,%r1)" Nothing
+    testKs ArchSystemz [ModeBigEndian] ["a %r0, 4095(%r15,%r1)"] Nothing

bindings/haskell/src/Keystone.hs

@@ -9,35 +9,34 @@ framework.
 
 Further information is available at <http://www.keystone-engine.org>.
 -}
-module Keystone (
-    -- * Assembler control
-    Assembler,
-    Engine,
-    Architecture(..),
-    Mode(..),
-    OptionType(..),
-    OptionValue(..),
-    runAssembler,
-    open,
-    option,
-    assemble,
-
-    -- * Error handling
-    Error(..),
-    errno,
-    strerror,
-
-    -- * Misc.
-    version,
-) where
+module Keystone
+    ( -- * Assembler control
+      Assembler
+    , Engine
+    , Architecture(..)
+    , Mode(..)
+    , OptionType(..)
+    , OptionValue(..)
+    , runAssembler
+    , open
+    , option
+    , assemble
+
+      -- * Error handling
+    , Error(..)
+    , errno
+    , strerror
+
+      -- * Misc.
+    , version
+    ) where
 
 import Control.Monad.Trans.Class (lift)
 import Control.Monad.Trans.Either (left, right, runEitherT)
-import Data.ByteString (packCStringLen)
+import Data.ByteString (ByteString, packCStringLen)
+import Data.List (intercalate)
 import Foreign
 
-import Data.ByteString (ByteString)
-
 import Keystone.Internal.Core
 import Keystone.Internal.Keystone
 
@@ -79,17 +78,17 @@ option ks optType optValue = do
     else
         left err
 
--- | Assemble a string given its buffer and start address.
+-- | Assemble a list of statements.
 assemble :: Engine                      -- ^ 'Keystone' engine handle
-         -> String                      -- ^ String to assemble. Use ';' or
-                                        -- '\n' to separate statements.
+         -> [String]                    -- ^ List of statements to assemble.
          -> Maybe Word64                -- ^ Optional address of the first
                                         -- assembly instruction
          -> Assembler (ByteString, Int) -- ^ Returns the encoded input assembly
                                         -- string and the number of statements
                                         -- successfully processed. Returns an
                                         -- 'Error' on failure
-assemble ks string addr = do
+assemble ks stmts addr = do
+    let string = intercalate ";" stmts
     (res, encPtr, encSize, statCount) <- lift $ ksAsm ks string (maybeZ addr)
     if res == 0 then do
         -- If ksAsm completed successfully, pack the encoded bytes into a

bindings/haskell/src/Keystone/CPU/Arm.chs

@@ -8,16 +8,18 @@ License     : GPL-2
 
 Definitions for the ARM architecture.
 -}
-module Keystone.CPU.Arm (
-    Error(..),
-) where
+module Keystone.CPU.Arm
+    (
+      Error(..)
+    ) where
 
-{# context lib="keystone" #}
+{# context lib = "keystone" #}
 
 #include <keystone/arm.h>
 
 -- | ARM errors.
 {# enum ks_err_asm_arm as Error
-    {underscoreToCase}
-    with prefix="KS_ERR_ASM_ARM_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_ERR_ASM_ARM_"
+   deriving (Show, Eq, Bounded)
+#}

bindings/haskell/src/Keystone/CPU/Arm64.chs

@@ -8,16 +8,18 @@ License     : GPL-2
 
 Definitions for the ARM64 architecture.
 -}
-module Keystone.CPU.Arm64 (
-    Error(..),
-) where
+module Keystone.CPU.Arm64
+    (
+      Error(..)
+    ) where
 
-{# context lib="keystone" #}
+{# context lib = "keystone" #}
 
 #include <keystone/arm64.h>
 
 -- | ARM64 errors.
 {# enum ks_err_asm_arm64 as Error
-    {underscoreToCase}
-    with prefix="KS_ERR_ASM_ARM64_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_ERR_ASM_ARM64_"
+   deriving (Show, Eq, Bounded)
+#}

bindings/haskell/src/Keystone/CPU/Hexagon.chs

@@ -8,16 +8,18 @@ License     : GPL-2
 
 Definitions for the Hexagon architecture.
 -}
-module Keystone.CPU.Hexagon (
-    Error(..),
-) where
+module Keystone.CPU.Hexagon
+    (
+      Error(..)
+    ) where
 
-{# context lib="keystone" #}
+{# context lib = "keystone" #}
 
 #include <keystone/hexagon.h>
 
 -- | Hexagon errors.
 {# enum ks_err_asm_hexagon as Error
-    {underscoreToCase}
-    with prefix="KS_ERR_ASM_HEXAGON_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_ERR_ASM_HEXAGON_"
+   deriving (Show, Eq, Bounded)
+#}

bindings/haskell/src/Keystone/CPU/Mips.chs

@@ -8,16 +8,18 @@ License     : GPL-2
 
 Definitions for the MIPS architecture.
 -}
-module Keystone.CPU.Mips (
-    Error(..),
-) where
+module Keystone.CPU.Mips
+    (
+      Error(..)
+    ) where
 
-{# context lib="keystone" #}
+{# context lib = "keystone" #}
 
 #include <keystone/mips.h>
 
 -- | MIPS errors.
 {# enum ks_err_asm_mips as Error
-    {underscoreToCase}
-    with prefix="KS_ERR_ASM_MIPS_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_ERR_ASM_MIPS_"
+   deriving (Show, Eq, Bounded)
+#}

bindings/haskell/src/Keystone/CPU/Ppc.chs

@@ -8,16 +8,18 @@ License     : GPL-2
 
 Definitions for the PPC architecture.
 -}
-module Keystone.CPU.Ppc (
-    Error(..),
-) where
+module Keystone.CPU.Ppc
+    (
+      Error(..)
+    ) where
 
-{# context lib="keystone" #}
+{# context lib = "keystone" #}
 
 #include <keystone/ppc.h>
 
 -- | PPC errors.
 {# enum ks_err_asm_ppc as Error
-    {underscoreToCase}
-    with prefix="KS_ERR_ASM_PPC_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_ERR_ASM_PPC_"
+   deriving (Show, Eq, Bounded)
+#}

bindings/haskell/src/Keystone/CPU/Sparc.chs

@@ -8,16 +8,17 @@ License     : GPL-2
 
 Definitions for the SPARC architecture.
 -}
-module Keystone.CPU.Sparc (
-    Error(..),
-) where
+module Keystone.CPU.Sparc
+    (
+      Error(..)
+    ) where
 
-{# context lib="keystone" #}
+{# context lib = "keystone" #}
 
 #include <keystone/sparc.h>
 
 -- | SPARC errors.
 {# enum ks_err_asm_sparc as Error
-    {underscoreToCase}
-    with prefix="KS_ERR_ASM_SPARC_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_ERR_ASM_SPARC_"
+   deriving (Show, Eq, Bounded) #}

bindings/haskell/src/Keystone/CPU/SystemZ.chs

@@ -8,16 +8,18 @@ License     : GPL-2
 
 Definitions for the SystemZ architecture.
 -}
-module Keystone.CPU.SystemZ (
-    Error(..),
-) where
+module Keystone.CPU.SystemZ
+    (
+      Error(..)
+    ) where
 
-{# context lib="keystone" #}
+{# context lib = "keystone" #}
 
 #include <keystone/systemz.h>
 
 -- | SystemZ errors.
 {# enum ks_err_asm_systemz as Error
-    {underscoreToCase}
-    with prefix="KS_ERR_ASM_SYSTEMZ_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_ERR_ASM_SYSTEMZ_"
+   deriving (Show, Eq, Bounded)
+#}

bindings/haskell/src/Keystone/CPU/X86.chs

@@ -8,16 +8,18 @@ License     : GPL-2
 
 Definitions for the X86 architecture.
 -}
-module Keystone.CPU.X86 (
-    Error(..),
-) where
+module Keystone.CPU.X86
+    (
+      Error(..)
+    ) where
 
-{# context lib="keystone" #}
+{# context lib = "keystone" #}
 
 #include <keystone/x86.h>
 
 -- | X86 errors.
 {# enum ks_err_asm_x86 as Error
-    {underscoreToCase}
-    with prefix="KS_ERR_ASM_X86_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_ERR_ASM_X86_"
+   deriving (Show, Eq, Bounded)
+#}

bindings/haskell/src/Keystone/Internal/Core.chs

@@ -17,31 +17,34 @@ import Control.Monad
 import Control.Monad.Trans.Either (EitherT)
 import Foreign
 
-{# context lib="keystone" #}
+{# context lib = "keystone" #}
 
 #include <keystone/keystone.h>
 #include "keystone_wrapper.h"
 
 -- | The Keystone engine.
 {# pointer *ks_engine as Engine
-    foreign finalizer ks_close_wrapper as close
-    newtype #}
+   foreign finalizer ks_close_wrapper as close
+   newtype
+#}
 
 -- | A pointer to the Keystone engine.
 {# pointer *ks_engine as EnginePtr -> Engine #}
 
 -- | Make a new Keystone engine out of an engine pointer. The returned Keystone
 -- engine will automatically call 'ks_close_wrapper' when it goes out of scope.
-mkEngine :: EnginePtr -> IO Engine
+mkEngine :: EnginePtr
+         -> IO Engine
 mkEngine ptr =
     liftM Engine (newForeignPtr close ptr)
 
 -- | Errors encountered by the Keystone API. These values are returned by
 -- 'errno'.
 {# enum ks_err as Error
-    {underscoreToCase}
-    with prefix="KS_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_"
+   deriving (Show, Eq, Bounded)
+#}
 
 -- | The assembler runs in the IO monad and allows for the handling of errors
 -- "under the hood".

bindings/haskell/src/Keystone/Internal/Keystone.chs

@@ -11,32 +11,32 @@ Low-level bindings for the Keystone assembler engine.
 This module should not be directly imported; it is only exposed because of the
 way cabal handles ordering of chs files.
 -}
-module Keystone.Internal.Keystone (
-    -- * Types
-    Architecture(..),
-    Mode(..),
-    OptionType(..),
-    OptionValue(..),
-
-    -- * Function bindings
-    ksOpen,
-    ksOption,
-    ksFree,
-    ksAsm,
-    ksVersion,
-    ksErrno,
-    ksStrerror,
-) where
+module Keystone.Internal.Keystone
+    ( -- * Types
+      Architecture(..)
+    , Mode(..)
+    , OptionType(..)
+    , OptionValue(..)
+
+      -- * Function bindings
+    , ksOpen
+    , ksOption
+    , ksFree
+    , ksAsm
+    , ksVersion
+    , ksErrno
+    , ksStrerror
+    ) where
 
 import Foreign
 import Foreign.C
 
 import Keystone.Internal.Util
 
-{# context lib="keystone" #}
-
 {# import Keystone.Internal.Core #}
 
+{# context lib = "keystone" #}
+
 #include <keystone/keystone.h>
 
 -------------------------------------------------------------------------------
@@ -45,78 +45,91 @@ import Keystone.Internal.Util
 
 -- | CPU architecture.
 {# enum ks_arch as Architecture
-    {underscoreToCase}
-    with prefix="KS_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_"
+   deriving (Show, Eq, Bounded)
+#}
 
 -- | CPU hardware mode.
 {# enum ks_mode as Mode
-    {underscoreToCase}
-    with prefix="KS_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_"
+   deriving (Show, Eq, Bounded)
+#}
 
 -- | Runtime option types.
 {# enum ks_opt_type as OptionType
-    {underscoreToCase}
-    with prefix="KS_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_"
+   deriving (Show, Eq, Bounded)
+#}
 
 -- | Runtime option values.
 {# enum ks_opt_value as OptionValue
-    {underscoreToCase}
-    with prefix="KS_OPT_"
-    deriving (Show, Eq, Bounded) #}
+   { underscoreToCase }
+   with prefix = "KS_OPT_"
+   deriving (Show, Eq, Bounded)
+#}
 
 -------------------------------------------------------------------------------
 -- Assembler control
 -------------------------------------------------------------------------------
 
 {# fun ks_open as ^
-    {`Architecture',
-     combineEnums `[Mode]',
-     alloca- `EnginePtr' peek*}
-    -> `Error' #}
+   { `Architecture'
+   , combineEnums `[Mode]'
+   , alloca- `EnginePtr' peek*
+   } -> `Error'
+#}
 
 {# fun ks_option as ^
-    {`Engine',
-     `OptionType',
-     `OptionValue'}
-    -> `Error' #}
+   { `Engine'
+   , `OptionType'
+   , `OptionValue'
+   } -> `Error'
+#}
 
 {# fun ks_asm as ^
-    {`Engine',
-     `String',
-     `Word64',
-     alloca- `Ptr CUChar' peek*,
-     alloca- `Int' peekToInt*,
-     alloca- `Int' peekToInt*}
-    -> `Int' #}
+   { `Engine'
+   ,  `String'
+   ,  `Word64'
+   ,  alloca- `Ptr CUChar' peek*
+   ,  alloca- `Int' peekToInt*
+   ,  alloca- `Int' peekToInt*
+   } -> `Int'
+#}
 
 {# fun ks_free as ^
-    {castPtr `Ptr CUChar'}
-    -> `()' #}
+   { castPtr `Ptr CUChar'
+   } -> `()'
+#}
 
 -------------------------------------------------------------------------------
 -- Misc.
 -------------------------------------------------------------------------------
 
 {# fun pure unsafe ks_version as ^
-    {id `Ptr CUInt',
-     id `Ptr CUInt'}
-    -> `Int' #}
+   { id `Ptr CUInt'
+   , id `Ptr CUInt'
+   } -> `Int'
+#}
 
 {# fun unsafe ks_errno as ^
-    {`Engine'}
-    -> `Error' #}
+   { `Engine'
+   } -> `Error'
+#}
 
 {# fun pure unsafe ks_strerror as ^
-    {`Error'}
-    -> `String' #}
+   { `Error'
+   } -> `String'
+#}
 
 -------------------------------------------------------------------------------
 -- Helper functions
 -------------------------------------------------------------------------------
 
-peekToInt :: (Storable a, Integral a, Num b) => Ptr a -> IO b
+peekToInt :: (Storable a, Integral a, Num b)
+          => Ptr a
+          -> IO b
 peekToInt ptr =
     peek ptr >>= (return . fromIntegral)

bindings/haskell/src/Keystone/Internal/Util.hs

@@ -9,11 +9,15 @@ module Keystone.Internal.Util where
 import Data.Bits
 
 -- | Combine a list of Enums by performing a bitwise-OR.
-combineEnums :: (Enum a, Num b, Bits b) => [a] -> b
+combineEnums :: (Enum a, Num b, Bits b)
+             => [a]
+             -> b
 combineEnums =
     foldr ((.|.) <$> enumToNum) 0
 
 -- | Convert an 'Eum' to a 'Num'.
-enumToNum :: (Enum a, Num b) => a -> b
+enumToNum :: (Enum a, Num b)
+          => a
+          -> b
 enumToNum =
     fromIntegral . fromEnum