content: {-# LANGUAGE OverloadedStrings #-}
  -- |Generate a Storable instance for ROS msg types.
  module Instances.Storable (genStorableInstance) where
  import Control.Monad ((>=>))
  import Data.ByteString.Char8 (ByteString, pack)
  import qualified Data.ByteString.Char8 as B
  import Data.Maybe (fromJust)
  import Types
  import Analysis
  
  rosPoke :: MsgType -> ByteString
  rosPoke (RFixedArray _ t) = B.concat [ "V.mapM_ (", rosPoke t, ")" ]
  rosPoke _ = "SM.poke"
  
  rosPeek :: MsgType -> ByteString
  rosPeek (RFixedArray n t) = B.concat [ "V.replicateM ", B.pack (show n), 
                                         " (", rosPeek t, ")" ]
  rosPeek _ = "SM.peek"
  
  genStorableInstance :: Msg -> MsgInfo (ByteString, ByteString)
  genStorableInstance msg 
    | null (fields msg) = return ("import Foreign.Storable (Storable(..))\n",
                                  singletonStorable)
    | otherwise = isFlat msg >>= aux
      where aux False = return ("", "")
            aux True = do sz <- totalSize msg
                          return (smImp, stInst sz)
            --peekFields = map (const "SM.peek") (fields msg)
            peekFields = map (rosPeek . fieldType) (fields msg)
            -- pokeFields = map ((\n -> B.concat ["SM.poke (", n, " obj')"]) . 
            --                   fieldName)
            --                  (fields msg)
            pokeFields = map (\f -> B.concat [ rosPoke (fieldType f)
                                             , " (", fieldName f
                                             , " obj')"])
                             (fields msg)
            name = pack (shortName msg)
            stInst sz = B.concat ["instance Storable ", name, " where\n",
                                  "  sizeOf _ = ", sz,"\n",
                                  "  alignment _ = 8\n",
                                  "  peek = SM.runStorable (", name, " <$> ",
                                  B.intercalate " <*> " peekFields, ")\n",
                                  "  poke ptr' obj' = ",
                                  "SM.runStorable store' ptr'\n",
                                  "    where store' = ",
                                  B.intercalate " *> " pokeFields,"\n\n"]
            smImp = B.concat [ "import Foreign.Storable (Storable(..))\n"
                             , "import qualified Ros.Internal.Util.StorableMonad"
                             , " as SM\n" ]
            singletonStorable = B.concat [ "instance Storable ", name, " where\n"
                                         , "  sizeOf _ = 1\n"
                                         , "  alignment _ = 1\n"
                                         , "  peek _ = pure ", name, "\n"
                                         , "  poke _ _ = pure ()\n\n" ]
  
  
  totalSize :: Msg -> MsgInfo ByteString
  totalSize msg = B.intercalate sep `fmap` mapM (aux . fieldType) (fields msg)
      where aux = getTypeInfo >=> return . fromJust . size
            sep = B.append " +\n" $ B.replicate 13 ' '
  
  