hs2ats 0.2.1.2 → 0.2.1.3
raw patch · 2 files changed
+22/−21 lines, 2 filesdep ~language-atsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: language-ats
API changes (from Hackage documentation)
Files
- hs2ats.cabal +1/−1
- src/Language/ATS/Generate.hs +21/−20
hs2ats.cabal view
@@ -1,5 +1,5 @@ name: hs2ats-version: 0.2.1.2+version: 0.2.1.3 synopsis: Create ATS types from Haskell types description: This package enables scanning Haskell source files for data types and then generating [ATS](http://www.ats-lang.org/) types from them. homepage: https://github.com/vmchale/hs2ats#readme
src/Language/ATS/Generate.hs view
@@ -17,7 +17,7 @@ import Control.Lens (over, _head) import Data.Char (toUpper) import Data.Either (lefts, rights)-import Data.Maybe (fromJust)+import Data.Maybe import qualified Data.Text as T import Language.ATS as ATS import Language.ATS.Generate.Error@@ -52,17 +52,18 @@ stringTypeConv "CString" = Right "Strptr1" stringTypeConv "Word" = Right "uint" stringTypeConv "CUInt" = Right "uint"+stringTypeConv "Int" = Right "int"+stringTypeConv "CInt" = Right "int"+stringTypeConv "Float" = Right "float"+stringTypeConv "CFloat" = Right "float"+stringTypeConv "Double" = Right "double"+stringTypeConv "Bool" = Right "bool"+stringTypeConv "CBool" = Right "bool" stringTypeConv _ = unsupported "stringTypeConv" toStringATS' :: QName a -> ErrM ATS.Type-toStringATS' (QNamed _ _ "Int") = Right ATS.Int-toStringATS' (QNamed _ _ "CInt") = Right ATS.Int-toStringATS' (QNamed _ _ "Float") = Right ATS.Float-toStringATS' (QNamed _ _ "CFloat") = Right ATS.Float-toStringATS' (QNamed _ _ "Bool") = Right ATS.Bool-toStringATS' (QNamed _ _ "CBool") = Right ATS.Bool-toStringATS' (QNamed _ _ s) = Named . Unqualified <$> stringTypeConv s-toStringATS' _ = unsupported "toStringATS'"+toStringATS' (QNamed _ _ s) = Named . Unqualified <$> stringTypeConv s+toStringATS' _ = unsupported "toStringATS'" typeToType :: HS.Type a -> ErrM ATS.Type typeToType (TyCon _ qn) = toStringATS' qn@@ -89,15 +90,15 @@ toStringATS (Ident _ s) = s toStringATS _ = undefined -tyvarToArg :: Bool -> TyVarBind a -> ErrM Arg-tyvarToArg False (UnkindedVar _ n) = Right $ Arg (Both (toStringATS n) (Vt0p None))-tyvarToArg True (UnkindedVar _ n) = Right $ Arg (Both (toStringATS n) (Vt0p Plus))+tyvarToArg :: Bool -> TyVarBind a -> ErrM SortArg+tyvarToArg False (UnkindedVar _ n) = Right $ SortArg (toStringATS n) (Vt0p None)+tyvarToArg True (UnkindedVar _ n) = Right $ SortArg (toStringATS n) (Vt0p Plus) tyvarToArg _ _ = unsupported "tyvarToArg" consM :: (Monad m) => m a -> m [a] -> m [a] consM x xs = (:) <$> x <*> xs -asATSName :: DeclHead a -> ErrM (String, [Arg])+asATSName :: DeclHead a -> ErrM (String, [SortArg]) asATSName (DHead _ n) = Right (convertConventions $ toStringATS n, []) asATSName (DHParen _ d) = (,) . fst <$> asATSName d <*> pure [] asATSName (DHApp _ d tb) = (,) . fst <$> asATSName d <*> consM (tyvarToArg False tb) (snd <$> asATSName d)@@ -111,16 +112,16 @@ qualConDeclToLeaf (EmptyQualCon _ cd) = Leaf [] <$> (over _head toUpper . convertConventions . fst <$> conDeclToType cd) <*> pure [] <*> (snd <$> conDeclToType cd) qualConDeclToLeaf _ = unsupported "qualConDeclToLeaf" -addNils :: [Arg] -> [Arg]-addNils [] = [NoArgs]-addNils x = x+pruneATSNils :: [SortArg] -> Maybe [SortArg]+pruneATSNils [] = Nothing+pruneATSNils x = Just x -- TODO if it derives functor, use + asATSType :: Decl a -> ErrM Declaration-asATSType (TypeDecl _ dh t) = ViewTypeDef undefined <$> (fst <$> asATSName dh) <*> (addNils . snd <$> asATSName dh) <*> typeToType t-asATSType (DataDecl _ NewType{} _ dh [qcd] _) = ViewTypeDef undefined <$> (fst <$> asATSName dh) <*> (addNils . snd <$> asATSName dh) <*> qualConDeclToType qcd-asATSType (DataDecl _ DataType{} _ dh [qcd] _) = ViewTypeDef undefined <$> (fst <$> asATSName dh) <*> (addNils . snd <$> asATSName dh) <*> qualConDeclToType qcd-asATSType (DataDecl _ DataType{} _ dh qcds _) = SumViewType <$> (fst <$> asATSName dh) <*> (addNils . snd <$> asATSName dh) <*> mapM qualConDeclToLeaf (reverse qcds)+asATSType (TypeDecl _ dh t) = ViewTypeDef undefined <$> (fst <$> asATSName dh) <*> (pruneATSNils . snd <$> asATSName dh) <*> typeToType t+asATSType (DataDecl _ NewType{} _ dh [qcd] _) = ViewTypeDef undefined <$> (fst <$> asATSName dh) <*> (pruneATSNils . snd <$> asATSName dh) <*> qualConDeclToType qcd+asATSType (DataDecl _ DataType{} _ dh [qcd] _) = ViewTypeDef undefined <$> (fst <$> asATSName dh) <*> (pruneATSNils . snd <$> asATSName dh) <*> qualConDeclToType qcd+asATSType (DataDecl _ DataType{} _ dh qcds _) = SumViewType <$> (fst <$> asATSName dh) <*> (pruneATSNils . snd <$> asATSName dh) <*> mapM qualConDeclToLeaf (reverse qcds) asATSType _ = unsupported "asATSType" -- TODO GDataDecl and DataFamDecl