hs2ats 0.2.1.5 → 0.2.1.6
raw patch · 3 files changed
+23/−37 lines, 3 filesdep +casingdep −casesdep −textdep ~language-atsPVP ok
version bump matches the API change (PVP)
Dependencies added: casing
Dependencies removed: cases, text
Dependency ranges changed: language-ats
API changes (from Hackage documentation)
Files
- README.md +0/−12
- hs2ats.cabal +3/−5
- src/Language/ATS/Generate.hs +20/−20
− README.md
@@ -1,12 +0,0 @@-# hs2ats--This is a tool to convert Haskell types to ATS types. So far it works quite-well, but documentation is sparse.--Example use:--```-hs2ats --src DataTypes.hs --target generated_types.sats-```--Note also that `hs2ats` does not preserve strictness semantics.
hs2ats.cabal view
@@ -1,5 +1,5 @@ name: hs2ats-version: 0.2.1.5+version: 0.2.1.6 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@@ -10,7 +10,6 @@ copyright: Copyright: (c) 2018 Vanessa McHale category: Language, Haskell, ATS build-type: Simple-extra-doc-files: README.md cabal-version: 1.18 Flag development {@@ -25,9 +24,8 @@ , Language.ATS.Generate.Error build-depends: base >= 4.7 && < 5 , haskell-src-exts- , language-ats- , text- , cases+ , language-ats >= 1.0.0.0+ , casing , lens , optparse-generic , ansi-wl-pprint
src/Language/ATS/Generate.hs view
@@ -12,20 +12,19 @@ , ErrM ) where -import Cases (snakify) import Control.Arrow import Control.Lens (over, _head) import Data.Bool (bool) import Data.Char (toUpper) import Data.Either (lefts, rights) import Data.Maybe-import qualified Data.Text as T import Language.ATS as ATS import Language.ATS.Generate.Error import Language.Haskell.Exts import Language.Haskell.Exts.Syntax as HS import Language.Preprocessor.Cpphs (defaultCpphsOptions, runCpphs) import Options.Generic+import Text.Casing (quietSnake) data Program = Program { src :: FilePath <?> "Haskell source file" , target :: FilePath <?> "ATS target"@@ -33,7 +32,7 @@ } deriving (Generic, ParseRecord) convertConventions :: String -> String-convertConventions = filterKeys . T.unpack . snakify . T.pack+convertConventions = filterKeys . quietSnake pattern QNamed :: l -> l -> String -> QName l pattern QNamed x y s = UnQual x (Ident y s)@@ -69,20 +68,19 @@ stringTypeConv "CBool" = Right "bool" stringTypeConv _ = unsupported "stringTypeConv" -toStringATS' :: QName a -> ErrM ATS.Type+toStringATS' :: QName a -> ErrM (ATS.Type b) toStringATS' (QNamed _ _ s) = Named . Unqualified <$> stringTypeConv s toStringATS' _ = unsupported "toStringATS'" -tyVarToSort :: TyVarBind a -> ErrM Universal+tyVarToSort :: TyVarBind a -> ErrM (Universal b) tyVarToSort (UnkindedVar _ (Ident _ s)) = Right $ Universal [s] (Just (Vt0p None)) mempty tyVarToSort _ = unsupported "tyVarToSort" -universalHelper :: [TyVarBind a] -> ErrM (ATS.Type -> ATS.Type)+universalHelper :: [TyVarBind a] -> ErrM (ATS.Type b -> ATS.Type b) universalHelper (t:ts) = fmap <$> (ForA <$> tyVarToSort t) <*> universalHelper ts universalHelper [] = pure id --- TODO track staloads?-typeToType :: HS.Type a -> ErrM ATS.Type+typeToType :: HS.Type a -> ErrM (ATS.Type b) typeToType (TyForall _ (Just us) Nothing t) = universalHelper us <*> typeToType t typeToType (TyCon _ qn) = toStringATS' qn typeToType (TyVar _ n) = Right $ Named $ Unqualified (toStringATS n)@@ -95,11 +93,11 @@ typeToType (TyTuple _ _ ts) = ATS.Tuple undefined <$> mapM typeToType ts typeToType _ = Left $ Unsupported "typeToType" -fieldDeclToType :: FieldDecl a -> ErrM (String, ATS.Type)+fieldDeclToType :: FieldDecl a -> ErrM (String, ATS.Type b) fieldDeclToType (FieldDecl _ [n] t) = (,) (toStringATS n) <$> typeToType t fieldDeclToType _ = Left $ Unsupported "fieldDeclToType" -conDeclToType :: ConDecl a -> ErrM (String, Maybe ATS.Type)+conDeclToType :: ConDecl a -> ErrM (String, Maybe (ATS.Type b)) conDeclToType (ConDecl _ n []) = Right (toStringATS n, Nothing) conDeclToType (ConDecl _ n [t]) = (,) (toStringATS n) . Just <$> typeToType t conDeclToType (ConDecl _ n ts) = (,) (toStringATS n) . Just . ATS.Tuple undefined <$> mapM typeToType ts@@ -110,7 +108,7 @@ toStringATS (Ident _ s) = s toStringATS _ = undefined -tyvarToArg :: Bool -> TyVarBind a -> ErrM SortArg+tyvarToArg :: Bool -> TyVarBind a -> ErrM (SortArg b) tyvarToArg False (UnkindedVar _ n) = Right $ SortArg (toStringATS n) (Vt0p None) tyvarToArg True (UnkindedVar _ n) = Right $ SortArg (toStringATS n) (Vt0p Plus) tyvarToArg _ _ = unsupported "tyvarToArg"@@ -118,26 +116,26 @@ consM :: (Monad m) => m a -> m [a] -> m [a] consM x xs = (:) <$> x <*> xs -asATSName :: DeclHead a -> ErrM (String, [SortArg])+asATSName :: DeclHead a -> ErrM (String, [SortArg b]) 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) asATSName _ = unsupported "asATSName" -qualConDeclToType :: QualConDecl a -> ErrM ATS.Type+qualConDeclToType :: QualConDecl a -> ErrM (ATS.Type b) qualConDeclToType (EmptyQualCon _ cd) = fromJust . snd <$> conDeclToType cd qualConDeclToType _ = unsupported "qualConDeclToType" -qualConDeclToLeaf :: QualConDecl a -> ErrM Leaf+qualConDeclToLeaf :: QualConDecl a -> ErrM (Leaf b) qualConDeclToLeaf (EmptyQualCon _ cd) = Leaf [] <$> (over _head toUpper . convertConventions . fst <$> conDeclToType cd) <*> pure [] <*> (snd <$> conDeclToType cd) qualConDeclToLeaf _ = unsupported "qualConDeclToLeaf" -pruneATSNils :: [SortArg] -> Maybe [SortArg]+pruneATSNils :: [SortArg a] -> Maybe [SortArg a] pruneATSNils [] = Nothing pruneATSNils x = Just x -- TODO if it derives functor, use +-asATSType :: Decl a -> ErrM Declaration+asATSType :: Decl a -> ErrM (Declaration b) 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@@ -156,12 +154,14 @@ modulePrint :: Module a -> (String, [GenerateError]) modulePrint = g . fmap asATSType . filterModule- where g = (printATS . ATS . reverse . rights) &&& lefts+ where g = (h . ATS . reverse . rights) &&& lefts+ h :: ATS AlexPosn -> String+ h = printATS extends :: ParseMode-extends = defaultParseMode- { extensions = EnableExtension <$> es- , fixities = Just baseFixities }+extends =+ defaultParseMode { extensions = EnableExtension <$> es, fixities = Just baseFixities }+ where es = [ StandaloneDeriving , CPP , RecordWildCards