HsWebots 0.1.1.0 → 0.1.1.1
raw patch · 3 files changed
+28/−194 lines, 3 filesdep −language-cdep −prettydep −shakespeare
Dependencies removed: language-c, pretty, shakespeare, syb, text
Files
- HsWebots.cabal +6/−30
- README.md +22/−0
- app/Main.hs +0/−164
HsWebots.cabal view
@@ -4,15 +4,15 @@ -- -- see: https://github.com/sol/hpack ----- hash: d7399ff5367c55e2b2afaaae32dcf8116890e0a71844b15a4b105fd4f5564ee8+-- hash: b96f385147c1443ab495b6f5dfa3fff31e763c413f6518c2dc558d80d71b6926 name: HsWebots-version: 0.1.1.0+version: 0.1.1.1 synopsis: Webots bindings for Haskell-description: Please see the README on GitHub at <https://github.com/junjihashimoto/HsWebots#readme>+description: Please see the README on GitHub at <https://github.com/cyberbotics/HsWebots#readme> category: Robotics-homepage: https://github.com/junjihashimoto/HsWebots#readme-bug-reports: https://github.com/junjihashimoto/HsWebots/issues+homepage: https://github.com/cyberbotics/HsWebots#readme+bug-reports: https://github.com/cyberbotics/HsWebots/issues author: Junji Hashimoto maintainer: junji.hashimoto@gmail.com copyright: 2020 Junji Hashimoto@@ -25,7 +25,7 @@ source-repository head type: git- location: https://github.com/junjihashimoto/HsWebots+ location: https://github.com/cyberbotics/HsWebots library exposed-modules:@@ -78,30 +78,6 @@ , inline-c-cpp >=0.4.0.0 , safe-exceptions , template-haskell- , vector- default-language: Haskell2010--executable HsWebots-exe- main-is: Main.hs- other-modules:- Paths_HsWebots- hs-source-dirs:- app- ghc-options: -threaded -rtsopts -with-rtsopts=-N- build-depends:- HsWebots- , JuicyPixels- , base >=4.7 && <5- , bytestring- , inline-c >=0.9.0.0- , inline-c-cpp >=0.4.0.0- , language-c- , pretty- , safe-exceptions- , shakespeare- , syb- , template-haskell- , text , vector default-language: Haskell2010
README.md view
@@ -1,3 +1,25 @@ # HsWebots +[](https://hackage.haskell.org/package/HsWebots)+++++ Webots bindings for Haskell++# Usage++```+#setup WEBOTS_HOME and LD_LIBRARY_PATH+source setenv ++#Build+stack build+```++# Supported Platform++* Webots: R2020a revision 1+* OS: ubuntu/bionic and macos(Mojave)+* Build Tools: stack
− app/Main.hs
@@ -1,164 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}---module Main where--import System.IO-import System.Environment-import Data.Generics-import Data.List-import Language.C-import Language.C.System.GCC-import Language.C.Data-import Language.C.Data.Ident-import Text.PrettyPrint-import Control.Monad-import Text.Shakespeare.Text-import qualified Data.Text.IO as T--whenM cond exp = if cond then exp else pure ()--main = do- (filename:[]) <- getArgs- parseMyFile filename >>= \i -> do- case i of- CTranslUnit v a -> do- forM_ v $ \i -> do- printFunc filename i--parseMyFile :: FilePath -> IO CTranslUnit-parseMyFile input_file =- do parse_result <- parseCFile (newGCC "gcc") Nothing ["-Ideps/webots/include"] input_file- case parse_result of- Left parse_err -> error (show parse_err)- Right ast -> return ast--class CIdent a where- toIdent :: a -> String--instance CIdent Ident where- toIdent a = identToString a --instance CIdent (CStorageSpecifier NodeInfo) where- toIdent a = render $ pretty a --instance CIdent (CTypeSpecifier NodeInfo) where- toIdent a = render $ pretty a --instance CIdent (CTypeQualifier NodeInfo) where- toIdent a = render $ pretty a --instance CIdent (CFunctionSpecifier NodeInfo) where- toIdent a = render $ pretty a --instance CIdent (CAlignmentSpecifier NodeInfo) where- toIdent a = render $ pretty a --instance CIdent (CDeclarationSpecifier NodeInfo) where- toIdent a = render $ pretty a --instance CIdent (CDeclaration NodeInfo) where- toIdent (CDecl [CStorageSpec a] _ _) = toIdent a- toIdent (CDecl [CTypeSpec a] _ _) = toIdent a- toIdent (CDecl [CTypeQual a] _ _) = toIdent a- toIdent (CDecl [CFunSpec a] _ _) = toIdent a- toIdent (CDecl [CAlignSpec a] _ _) = toIdent a- toIdent (CDecl a _ _) = intercalate "," $ map toIdent a- toIdent a = "not-parsed"---csnd (CDecl [CStorageSpec a] b _) = b-csnd (CDecl [CTypeSpec a] b _) = b-csnd (CDecl [CTypeQual a] b _) = b-csnd (CDecl [CFunSpec a] b _) = b-csnd (CDecl [CAlignSpec a] b _) = b-csnd (CDecl a b _) = b-csnd a = undefined--getArgIds [] = []-getArgIds ((Just (CDeclr- (Just arg)- _- _- _- _- )):xs) = toIdent arg : getArgIds xs-getArgIds (_:xs) = "xxx" : getArgIds xs- -printFunc :: FilePath -> CExternalDeclaration NodeInfo -> IO ()-printFunc path (CDeclExt (CDecl- rets- [(Just (CDeclr- (Just func_name)- (CFunDeclr (Right (args,_)) _ _:_)- _- _- _- )- ,_- ,_)]- (NodeInfo pos _ _)- )- ) = whenM (path == posFile pos) $ do- T.putStr [st|-#{toIdent func_name} :: #{argsH}IO #{retH} -#{toIdent func_name} #{argIds} =- #{bra} #{retC} { #{toIdent func_name}(#{argsC}) } #{ket}-|] - where- bra = "[C.exp|"- ket = "|]"- retH = case map toIdent rets of- ["void"] -> "()"- ["char"] -> "CBool"- ["int"] -> "CInt"- ["double"] -> "CDouble"- ["const","char"] -> "String"- ["const","double"] -> "Ptr CDouble"- [a] -> a- _ -> "UnKnown"- retC = case map toIdent rets of- ["void"] -> "void"- ["char"] -> "bool"- ["int"] -> "int"- ["double"] -> "double"- ["const","char"] -> "const char*"- ["const","double"] -> "const double*"- [a] -> a- argH arg = case arg of- "void" -> "()"- "char" -> "CBool"- "int" -> "CInt"- "double" -> "CDouble"- "const,char" -> "String"- "const,double" -> "Ptr CDouble"- a -> a- _ -> "UnKnown"- argsH =- case map (\(i :: CDeclaration NodeInfo) -> argH (toIdent i)) args of- [] -> ""- a -> (intercalate " -> " a) ++ " -> "- argC arg = case arg of- "void" -> "void"- "char" -> "bool"- "int" -> "int"- "double" -> "double"- "const,char" -> "const char*"- "const,double" -> "const double*"- a -> a- args' = getArgIds (map (\(a,b,c) -> a) $ concat $ map (\a -> csnd a) args)- argsC =- case (map (\(i :: CDeclaration NodeInfo) -> argC (toIdent i)) args,args') of- ([],_) -> ""- (_,[]) -> ""- (a,b) -> intercalate ", " $ map (\(aa,bb) -> "$("++ aa ++ " " ++ bb ++")" ) $ zip a b- argIds = intercalate " " args'-printFunc path (CDeclExt a@(CDecl ret body (NodeInfo pos _ _))) = return ()--- whenM (path == posFile pos) $ print a-printFunc path (CDeclExt a@(CStaticAssert exp lit _)) = return ()-printFunc path (CFDefExt a) = return ()-printFunc path (CAsmExt a _) = return ()-