packages feed

typed-wire 0.1.0.0 → 0.2.0.0

raw patch · 6 files changed

+107/−48 lines, 6 filesdep +file-embed

Dependencies added: file-embed

Files

README.md view
@@ -2,10 +2,11 @@ =====  [![Build Status](https://travis-ci.org/agrafix/typed-wire.svg)](https://travis-ci.org/agrafix/typed-wire)-+[![Hackage](https://img.shields.io/hackage/v/typed-wire.svg)](http://hackage.haskell.org/package/typed-wire)  ## Intro +Hackage: [typed-wire](http://hackage.haskell.org/package/typed-wire)  WIP: Language idependent type-safe communication @@ -21,7 +22,7 @@  Available options:   -h,--help                Show this help text-  --version                show version and exit+  --version                Show version and exit   -i,--include-dir DIR     Directory to search for modules   -e,--entrypoint MODULE-NAME                            Entrypoint for compiler@@ -32,6 +33,7 @@  ## Install +* Using cabal: `cabal install typed-wire` * From Source (cabal): `git clone https://github.com/agrafix/typed-wire.git && cd typed-wire && cabal install` * From Source (stack): `git clone https://github.com/agrafix/typed-wire.git && cd typed-wire && stack build`
app/Main.hs view
@@ -11,13 +11,13 @@  import qualified Paths_typed_wire as Meta -import Control.Monad import Development.GitRev import Options.Applicative import System.Directory import System.FilePath import qualified Data.Text as T import qualified Data.Text.IO as T+import qualified Data.Traversable as T import qualified Data.Version as Vers  data Options@@ -32,7 +32,7 @@ optParser :: Parser Options optParser =     Options-    <$> switch (long "version" <> help "show version and exit")+    <$> switch (long "version" <> help "Show version and exit")     <*> sourceDirsP     <*> entryPointsP     <*> hsOutP@@ -102,18 +102,23 @@              case checkModules ok of                Left err -> fail err                Right readyModules ->-                   forM_ readyModules $ \m ->-                   do case o_hsOutDir opts of-                        Just dir ->-                            runner m dir HS.makeModule HS.makeFileName-                        Nothing -> return ()-                      case o_elmOutDir opts of-                        Just dir ->-                            runner m dir Elm.makeModule Elm.makeFileName-                        Nothing -> return ()+                   do _ <- T.forM (o_hsOutDir opts) $ \dir ->+                          do storeLib dir HS.makeLibraryModule+                             mapM_ (runner dir HS.makeModule HS.makeFileName) readyModules+                      _ <- T.forM (o_elmOutDir opts) $ \dir ->+                          do storeLib dir Elm.makeLibraryModule+                             mapM_ (runner dir Elm.makeModule Elm.makeFileName) readyModules+                      return () -runner :: Module -> FilePath -> (Module -> T.Text) -> (ModuleName -> FilePath) -> IO ()-runner m baseDir mkModule mkFilename =+storeLib :: FilePath -> (FilePath, T.Text) -> IO ()+storeLib baseDir (baseLoc, content) =+    do let loc = baseDir </> baseLoc+       createDirectoryIfMissing True (takeDirectory loc)+       putStrLn $ "Writing library " <> loc <> " ..."+       T.writeFile loc content++runner :: FilePath -> (Module -> T.Text) -> (ModuleName -> FilePath) -> Module -> IO ()+runner baseDir mkModule mkFilename m =     let moduleSrc = mkModule m         moduleFp = baseDir </> mkFilename (m_name m)     in do createDirectoryIfMissing True (takeDirectory moduleFp)
src/TW/BuiltIn.hs view
@@ -2,7 +2,7 @@ module TW.BuiltIn     ( BuiltIn(..)     , allBuiltIns, isBuiltIn-    , tyString, tyInt, tyFloat, tyBool, tyMaybe+    , tyString, tyInt, tyFloat, tyBool, tyMaybe, tyBytes, tyList, tyDateTime, tyDate, tyTime     ) where @@ -18,7 +18,7 @@    } deriving (Show, Eq)  allBuiltIns :: [BuiltIn]-allBuiltIns = [tyString, tyInt, tyFloat, tyBool, tyMaybe]+allBuiltIns = [tyString, tyInt, tyFloat, tyBool, tyMaybe, tyBytes, tyList, tyDateTime, tyDate, tyTime]  isBuiltIn :: Type -> Maybe (BuiltIn, [Type]) isBuiltIn ty =@@ -50,3 +50,21 @@  tyMaybe :: BuiltIn tyMaybe = builtInVars "Maybe" ["a"]++tyList :: BuiltIn+tyList = builtInVars "List" ["a"]++tyBytes :: BuiltIn+tyBytes = builtIn "Bytes"++-- | DateTime type, format: YYYY-MM-DD HH:MM:SS[Z|+XX|-XX] or YYYY-MM-DDTHH:MM:SS[Z|+XX|-XX]+tyDateTime :: BuiltIn+tyDateTime = builtIn "DateTime"++-- | Date type, format: YYYY-MM-DD+tyDate :: BuiltIn+tyDate = builtIn "Date"++-- | Time type, format: HH:MM:SS+tyTime :: BuiltIn+tyTime = builtIn "Time"
src/TW/CodeGen/Elm.hs view
@@ -1,12 +1,16 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} module TW.CodeGen.Elm-    ( makeFileName, makeModule )+    ( makeFileName, makeModule+    , makeLibraryModule+    ) where  import TW.Ast import TW.BuiltIn import TW.JsonRepr +import Data.FileEmbed import Data.Maybe import Data.Monoid import System.FilePath@@ -25,6 +29,12 @@ jsonDec :: T.Text -> T.Text jsonDec x = jsonDecQual <> "." <> x +makeLibraryModule :: (FilePath, T.Text)+makeLibraryModule =+    ( "TW/Support/Lib.elm"+    , $(embedStringFile "support/elm/Lib.elm")+    )+ makeFileName :: ModuleName -> FilePath makeFileName (ModuleName parts) =     (L.foldl' (</>) "" $ map T.unpack parts) ++ ".elm"@@ -37,6 +47,7 @@     , ""     , T.intercalate "\n" (map makeImport $ m_imports m)     , ""+    , "import TW.Support.Lib as ELib"     , "import Json.Decode as " <> jsonDecQual     , "import Json.Decode exposing ((:=))"     , "import Json.Encode as " <> jsonEncQual@@ -65,13 +76,9 @@     , ""     , "jenc" <> unTypeName (sd_name sd) <> " : " <> encTy <> fullType <> " -> " <> jsonEnc "Value"     , "jenc" <> unTypeName (sd_name sd) <> " " <> encArgs <> " x ="-    , "    let packMaybe enc y ="-    , "           case y of"-    , "               Just val -> enc y"-    , "               Nothing -> " <> jsonEnc "null"-    , "    in " <> jsonEnc "object"-    , "       [ " <> T.intercalate "\n       , " (map makeToJsonFld $ sd_fields sd)-    , "       ]"+    , "    " <> jsonEnc "object"+    , "    [ " <> T.intercalate "\n    , " (map makeToJsonFld $ sd_fields sd)+    , "    ]"     , "jdec" <> unTypeName (sd_name sd) <> " : " <> jsonDec "Decoder" <> " (" <> fullType <> ")"     , "jdec" <> unTypeName (sd_name sd) <> " ="     , "    " <> T.intercalate "\n    " (map makeFromJsonFld $ sd_fields sd)@@ -122,12 +129,8 @@     , ""     , "jenc" <> unTypeName (ed_name ed) <> " : " <> encTy <> fullType <> " -> " <> jsonEnc "Value"     , "jenc" <> unTypeName (ed_name ed) <> " " <> encArgs <> " x ="-    , "    let packMaybe enc y ="-    , "           case y of"-    , "               Just val -> enc y"-    , "               Nothing -> " <> jsonEnc "null"-    , "    in case x of"-    , "         " <> T.intercalate "\n         " (map mkToJsonChoice $ ed_choices ed)+    , "    case x of"+    , "      " <> T.intercalate "\n      " (map mkToJsonChoice $ ed_choices ed)     , "jdec" <> unTypeName (ed_name ed) <> " : " <> jsonDec "Decoder" <> " (" <> fullType <> ")"     , "jdec" <> unTypeName (ed_name ed) <> " ="     , "    " <> jsonDec "oneOf"@@ -184,9 +187,17 @@           | bi == tyInt -> jsonEnc "int"           | bi == tyBool -> jsonEnc "bool"           | bi == tyFloat -> jsonEnc "float"+          | bi == tyBytes -> "ELib.jencAsBase64"+          | bi == tyDateTime -> "ELib.jencDateTime"+          | bi == tyTime -> "ELib.jencTime"+          | bi == tyDate -> "ELib.jencDate"+          | bi == tyList ->+              case tvars of+                [arg] -> jsonEnc "list" <> " (" <> jsonEncFor arg <> ")"+                _ -> error $ "Elm: odly shaped List value"           | bi == tyMaybe ->               case tvars of-                [arg] -> "packMaybe (" <> jsonEncFor arg <> ")"+                [arg] -> "ELib.packMaybe (" <> jsonEncFor arg <> ")"                 _ -> error $ "Elm: odly shaped Maybe value"           | otherwise ->               error $ "Elm: Missing jsonEnc for built in type: " ++ show t@@ -207,6 +218,14 @@           | bi == tyInt -> jsonDec "int"           | bi == tyBool -> jsonDec "bool"           | bi == tyFloat -> jsonDec "float"+          | bi == tyBytes -> "ELib.jdecAsBase64"+          | bi == tyDateTime -> "ELib.jdecDateTime"+          | bi == tyTime -> "ELib.jdecTime"+          | bi == tyDate -> "ELib.jdecDate"+          | bi == tyList ->+              case tvars of+                [arg] -> jsonDec "list" <> " (" <> jsonDecFor arg <> ")"+                _ -> error $ "Elm: odly shaped List value"           | bi == tyMaybe ->               case tvars of                 [arg] -> jsonDec "maybe" <> " (" <> jsonDecFor arg <> ")"@@ -236,7 +255,12 @@           | bi == tyInt -> "Int"           | bi == tyBool -> "Bool"           | bi == tyFloat -> "Float"+          | bi == tyDateTime -> "ELib.DateTime"+          | bi == tyTime -> "ELib.Time"+          | bi == tyDate -> "ELib.Date"           | bi == tyMaybe -> "(Maybe " <> T.intercalate " " (map makeType tvars) <> ")"+          | bi == tyList -> "(List " <> T.intercalate " " (map makeType tvars) <> ")"+          | bi == tyBytes -> "ELib.AsBase64"           | otherwise ->               error $ "Elm: Unimplemented built in type: " ++ show t
src/TW/CodeGen/Haskell.hs view
@@ -1,6 +1,9 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} module TW.CodeGen.Haskell-    ( makeFileName, makeModule )+    ( makeFileName, makeModule+    , makeLibraryModule+    ) where  import TW.Ast@@ -8,6 +11,7 @@ import TW.JsonRepr  import Data.Char+import Data.FileEmbed import Data.Maybe import Data.Monoid import System.FilePath@@ -20,11 +24,11 @@ aeson :: T.Text -> T.Text aeson x = aesonQual <> "." <> x -aesonTQual :: T.Text-aesonTQual = "Data_Aeson_Types"--aesonT :: T.Text -> T.Text-aesonT x = aesonTQual <> "." <> x+makeLibraryModule :: (FilePath, T.Text)+makeLibraryModule =+    ( "TW/Support/Lib.hs"+    , $(embedStringFile "support/haskell/Lib.hs")+    )  makeFileName :: ModuleName -> FilePath makeFileName (ModuleName parts) =@@ -33,17 +37,20 @@ makeModule :: Module -> T.Text makeModule m =     T.unlines-    [ "{-# LANGUAGE OverloadedStrings #-}"+    [ "{-# OPTIONS_GHC -fno-warn-unused-imports #-}"+    , "{-# LANGUAGE OverloadedStrings #-}"     , "-- | This file was auto generated by typed-wire. Do not modify by hand"     , "module " <> printModuleName (m_name m) <> " where"     , ""     , T.intercalate "\n" (map makeImport $ m_imports m)     , ""+    , "import qualified TW.Support.Lib as HLib"     , "import Control.Applicative"     , "import Control.Monad (join)"+    , "import Data.Time"     , "import qualified Data.Aeson as " <> aesonQual-    , "import qualified Data.Aeson.Types as " <> aesonTQual     , "import qualified Data.Text as T"+    , "import qualified Data.Vector as V"     , ""     , T.intercalate "\n" (map makeTypeDef $ m_typeDefs m)     ]@@ -123,9 +130,6 @@     , "    parseJSON = "     , "        " <> aeson "withObject" <> " " <> T.pack (show $ unTypeName (ed_name ed)) <> " $ \\obj ->"     , "        " <> T.intercalate "\n        <|> " (map mkFromJsonChoice $ ed_choices ed)-    , "        where"-    , "           eatBool :: Bool -> " <> aesonT "Parser" <> " ()"-    , "           eatBool _ = return ()"     ]     where       mkFromJsonChoice ec =@@ -133,7 +137,7 @@               tag = camelTo2 '_' $ T.unpack constr               (op, opEnd) =                   case ec_arg ec of-                    Nothing -> ("<$ (eatBool <$> (", "))")+                    Nothing -> ("<$ (HLib.eatBool <$> (", "))")                     Just _ -> ("<$>", "")           in "(" <> constr <> " " <> op <> " obj " <> (aeson ".:") <> " " <> T.pack (show tag) <> opEnd <> ")"       mkToJsonChoice ec =@@ -142,7 +146,7 @@               (argParam, argVal) =                   case ec_arg ec of                     Nothing -> ("", "True")-                    Just _ -> ("x", "x")+                    Just _ -> ("y", "y")           in constr <> " " <> argParam <> " -> " <> aeson "object"              <> " [" <> T.pack (show tag) <> " " <> aeson ".=" <> " " <> argVal <> "]"       fullType =@@ -174,8 +178,13 @@           | bi == tyBool -> "Bool"           | bi == tyFloat -> "Double"           | bi == tyMaybe -> "(Maybe " <> T.intercalate " " (map makeType tvars) <> ")"+          | bi == tyBytes -> "HLib.AsBase64"+          | bi == tyList -> "(V.Vector " <> T.intercalate " " (map makeType tvars) <> ")"+          | bi == tyDateTime -> "UTCTime"+          | bi == tyTime -> "TimeOfDay"+          | bi == tyDate -> "Day"           | otherwise ->-              error $ "Elm: Unimplemented built in type: " ++ show t+              error $ "Haskell: Unimplemented built in type: " ++ show t  makeQualTypeName :: QualTypeName -> T.Text makeQualTypeName qtn =
typed-wire.cabal view
@@ -1,5 +1,5 @@ name:                typed-wire-version:             0.1.0.0+version:             0.2.0.0 synopsis:            WIP: Language idependent type-safe communication description:         Please see README.md homepage:            http://github.com/agrafix/typed-wire#readme@@ -33,7 +33,8 @@                 mtl >=2.2,                 containers >=0.5,                 directory >=1.2,-                filepath >=1.4+                filepath >=1.4,+                file-embed >=0.0.9   default-language:    Haskell2010  executable twirec