From 2a5b1b42893a7f8ba935e52b742f766086fdc421 Mon Sep 17 00:00:00 2001 From: Wonwoo Choi Date: Sat, 10 Feb 2018 22:31:25 +0900 Subject: [PATCH 1/6] Add basic Rust target (WIP) --- examples/package.toml | 3 + src/Nirum/Targets.hs | 1 + src/Nirum/Targets/Rust.hs | 110 ++++++++++++++++++++++++++++++ src/Nirum/Targets/Rust/Keyword.hs | 48 +++++++++++++ 4 files changed, 162 insertions(+) create mode 100644 src/Nirum/Targets/Rust.hs create mode 100644 src/Nirum/Targets/Rust/Keyword.hs diff --git a/examples/package.toml b/examples/package.toml index 817b6c8..f30badd 100644 --- a/examples/package.toml +++ b/examples/package.toml @@ -6,3 +6,6 @@ minimum_runtime = "0.3.9" [targets.docs] title = "Nirum Examples" + +[targets.rust] +name = "nirum-examples" diff --git a/src/Nirum/Targets.hs b/src/Nirum/Targets.hs index 08f9891..2ad630d 100644 --- a/src/Nirum/Targets.hs +++ b/src/Nirum/Targets.hs @@ -39,6 +39,7 @@ import Nirum.Targets.List (targetProxyMapQ) -- docs/target/x.md file too. import Nirum.Targets.Docs () import Nirum.Targets.Python () +import Nirum.Targets.Rust () data BuildError = TargetNameError TargetName | CompileError (M.Map FilePath Text) diff --git a/src/Nirum/Targets/Rust.hs b/src/Nirum/Targets/Rust.hs new file mode 100644 index 0000000..32cb92a --- /dev/null +++ b/src/Nirum/Targets/Rust.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE DeriveDataTypeable, ExtendedDefaultRules, OverloadedLists, + QuasiQuotes, TypeFamilies, TypeSynonymInstances, + MultiParamTypeClasses #-} +module Nirum.Targets.Rust ( Rust + , Code + , CompileError + ) where + +import qualified Data.Map.Strict as M +import qualified Data.SemVer as SV +import qualified Data.Text as T +import Data.Text.Encoding (encodeUtf8) +import Data.Text.Lazy (toStrict) +import Data.Typeable (Typeable) + +import GHC.Exts (IsList (toList)) + +import System.FilePath (joinPath, replaceExtension) + +import Text.Blaze.Renderer.Text +import Text.Heterocephalus (compileText) + +import qualified Nirum.Constructs.Identifier as I +import Nirum.Constructs.Module +import Nirum.Constructs.ModulePath (ModulePath) +import Nirum.Constructs.Name +import Nirum.Constructs.TypeDeclaration +import Nirum.Package.Metadata +import qualified Nirum.Package.ModuleSet as MS +import Nirum.Targets.Rust.Keyword +import Nirum.TypeInstance.BoundModule + +data Rust = Rust { packageName :: T.Text + } + deriving (Eq, Ord, Show, Typeable) + +type Code = T.Text +type CompileError' = () + +genCargoToml :: Package Rust -> Code +genCargoToml Package { metadata = Metadata { version = version' + , target = Rust { packageName = name' } + } + } = + toStrict $ + renderMarkup [compileText|[package] +name = "#{ name' }" +version = "#{ SV.toLazyText version' }" +|] + +compileModule :: BoundModule Rust -> Code +compileModule m = + toStrict $ + renderMarkup [compileText|%{ forall (moduleName, members') <- enums } +pub enum #{ toRustIdentifier I.toPascalCaseText $ facialName moduleName } { +%{ forall EnumMember memberName _ <- members' } + #{ toRustIdentifier I.toPascalCaseText $ facialName memberName }, +%{ endforall } +} +%{ endforall } +|] + where + moduleTypes :: [TypeDeclaration] + moduleTypes = toList $ boundTypes m + enums :: [(Name, [EnumMember])] + enums = + [ (moduleName, toList members') + | TypeDeclaration { typename = moduleName + , type' = EnumType { members = members' } + } <- moduleTypes + ] + +compilePackage' :: Package Rust + -> M.Map FilePath (Either CompileError' Code) +compilePackage' package = + M.fromList $ + [ ( toFilename mp + , Right $ compileModule m + ) + | (mp, _) <- modules' + , Just m <- [resolveBoundModule mp package] + ] ++ + [ ("Cargo.toml", Right $ genCargoToml package) + , (joinPath ["src", "lib.rs"], Right "") + ] + where + convertModulePath :: ModulePath -> [FilePath] + convertModulePath mp = + "src" : + [ T.unpack (toRustIdentifier I.toSnakeCaseText i) + | i <- toList mp + ] + toFilename :: ModulePath -> FilePath + toFilename mp = + replaceExtension (joinPath $ convertModulePath mp) "rs" + modules' :: [(ModulePath, Module)] + modules' = MS.toAscList $ modules package + +instance Target Rust where + type CompileResult Rust = Code + type CompileError Rust = CompileError' + + targetName _ = "rust" + parseTarget table = do + name' <- stringField "name" table + return Rust { packageName = name' + } + compilePackage = compilePackage' + showCompileError _ _ = "" + toByteString _ = encodeUtf8 diff --git a/src/Nirum/Targets/Rust/Keyword.hs b/src/Nirum/Targets/Rust/Keyword.hs new file mode 100644 index 0000000..dc6a58e --- /dev/null +++ b/src/Nirum/Targets/Rust/Keyword.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE ExtendedDefaultRules, OverloadedLists, TypeSynonymInstances #-} +module Nirum.Targets.Rust.Keyword ( isPossibleKeyword + , toRustIdentifier + ) where + +import qualified Data.Set as S +import qualified Data.Text as T + +import qualified Nirum.Constructs.Identifier as I + +-- | The set of Rust keywords. +-- See also: https://doc.rust-lang.org/reference/keywords.html +strictKeywords :: S.Set T.Text +strictKeywords = + [ "as", "box", "break", "const", "continue" + , "crate", "else", "enum", "extern", "false" + , "fn", "for", "if", "impl", "in", "let" + , "loop", "match", "mod", "move", "mut", "pub" + , "ref", "return", "self", "Self", "static" + , "struct", "super", "trait", "true", "type" + , "unsafe", "use", "where", "while" + ] +weakKeywords :: S.Set T.Text +weakKeywords = + [ "catch", "default", "union", "'static" ] +reservedKeywords :: S.Set T.Text +reservedKeywords = + [ "abstract", "alignof", "become", "do" + , "final", "macro", "offsetof", "override" + , "priv", "proc", "pure", "sizeof", "typeof" + , "unsized", "virtual", "yield" + ] + +isPossibleKeyword :: T.Text -> Bool +isPossibleKeyword name' = + (findMember strictKeywords) || + (findMember weakKeywords) || + (findMember reservedKeywords) + where + findMember :: S.Set T.Text -> Bool + findMember = S.member name' + +toRustIdentifier :: (I.Identifier -> T.Text) -> I.Identifier -> T.Text +toRustIdentifier convertIdent identifier = + if isPossibleKeyword attrName then attrName `T.snoc` '_' else attrName + where + attrName :: T.Text + attrName = convertIdent identifier From 8eb7d1e3d30a967f5d680eababd2b228fc2309ea Mon Sep 17 00:00:00 2001 From: Wonwoo Choi Date: Sun, 11 Feb 2018 22:28:49 +0900 Subject: [PATCH 2/6] Declare submodules in mod.rs and lib.rs --- src/Nirum/Targets/Rust.hs | 63 ++++++--------- src/Nirum/Targets/Rust/Item.hs | 34 ++++++++ src/Nirum/Targets/Rust/ModuleTree.hs | 117 +++++++++++++++++++++++++++ 3 files changed, 176 insertions(+), 38 deletions(-) create mode 100644 src/Nirum/Targets/Rust/Item.hs create mode 100644 src/Nirum/Targets/Rust/ModuleTree.hs diff --git a/src/Nirum/Targets/Rust.hs b/src/Nirum/Targets/Rust.hs index 32cb92a..071ac97 100644 --- a/src/Nirum/Targets/Rust.hs +++ b/src/Nirum/Targets/Rust.hs @@ -9,25 +9,24 @@ module Nirum.Targets.Rust ( Rust import qualified Data.Map.Strict as M import qualified Data.SemVer as SV import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import Data.Text.Encoding (encodeUtf8) import Data.Text.Lazy (toStrict) import Data.Typeable (Typeable) import GHC.Exts (IsList (toList)) -import System.FilePath (joinPath, replaceExtension) - import Text.Blaze.Renderer.Text import Text.Heterocephalus (compileText) import qualified Nirum.Constructs.Identifier as I -import Nirum.Constructs.Module import Nirum.Constructs.ModulePath (ModulePath) -import Nirum.Constructs.Name import Nirum.Constructs.TypeDeclaration import Nirum.Package.Metadata import qualified Nirum.Package.ModuleSet as MS +import Nirum.Targets.Rust.Item import Nirum.Targets.Rust.Keyword +import Nirum.Targets.Rust.ModuleTree import Nirum.TypeInstance.BoundModule data Rust = Rust { packageName :: T.Text @@ -48,53 +47,41 @@ name = "#{ name' }" version = "#{ SV.toLazyText version' }" |] -compileModule :: BoundModule Rust -> Code -compileModule m = - toStrict $ - renderMarkup [compileText|%{ forall (moduleName, members') <- enums } -pub enum #{ toRustIdentifier I.toPascalCaseText $ facialName moduleName } { -%{ forall EnumMember memberName _ <- members' } - #{ toRustIdentifier I.toPascalCaseText $ facialName memberName }, -%{ endforall } -} +buildPrologue :: RustModule -> TL.Text +buildPrologue mod' = + renderMarkup [compileText|%{ forall child <- children mod' } +pub mod #{ toRustIdentifier I.toCamelCaseText child }; %{ endforall } |] + +buildBody :: Maybe (BoundModule Rust) -> TL.Text +buildBody (Just m) = + TL.concat [renderItem i | i <- moduleTypes] where moduleTypes :: [TypeDeclaration] moduleTypes = toList $ boundTypes m - enums :: [(Name, [EnumMember])] - enums = - [ (moduleName, toList members') - | TypeDeclaration { typename = moduleName - , type' = EnumType { members = members' } - } <- moduleTypes - ] +buildBody Nothing = TL.empty compilePackage' :: Package Rust -> M.Map FilePath (Either CompileError' Code) compilePackage' package = M.fromList $ - [ ( toFilename mp - , Right $ compileModule m + [ ( fileName + , Right $ + toStrict $ + TL.append (buildPrologue mod') + (buildBody (mp >>= resolveWithModulePath)) ) - | (mp, _) <- modules' - , Just m <- [resolveBoundModule mp package] + | mod'@RustModule { filePath = fileName + , modPath = mp + } <- modules' ] ++ - [ ("Cargo.toml", Right $ genCargoToml package) - , (joinPath ["src", "lib.rs"], Right "") - ] + [ ("Cargo.toml", Right $ genCargoToml package) ] where - convertModulePath :: ModulePath -> [FilePath] - convertModulePath mp = - "src" : - [ T.unpack (toRustIdentifier I.toSnakeCaseText i) - | i <- toList mp - ] - toFilename :: ModulePath -> FilePath - toFilename mp = - replaceExtension (joinPath $ convertModulePath mp) "rs" - modules' :: [(ModulePath, Module)] - modules' = MS.toAscList $ modules package + resolveWithModulePath :: ModulePath -> Maybe (BoundModule Rust) + resolveWithModulePath mp = resolveBoundModule mp package + modules' :: [RustModule] + modules' = buildRustModuleList [mp | (mp, _) <- MS.toAscList $ modules package] instance Target Rust where type CompileResult Rust = Code diff --git a/src/Nirum/Targets/Rust/Item.hs b/src/Nirum/Targets/Rust/Item.hs new file mode 100644 index 0000000..e5b9f48 --- /dev/null +++ b/src/Nirum/Targets/Rust/Item.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE ExtendedDefaultRules, OverloadedLists, TypeSynonymInstances, + QuasiQuotes #-} +module Nirum.Targets.Rust.Item ( renderItem + ) where + +import qualified Data.Text.Lazy as TL + +import GHC.Exts (IsList (toList)) + +import Text.Blaze.Renderer.Text +import Text.Heterocephalus (compileText) + +import qualified Nirum.Constructs.Identifier as I +import Nirum.Constructs.Name +import Nirum.Constructs.TypeDeclaration +import Nirum.Targets.Rust.Keyword + +renderItem :: TypeDeclaration -> TL.Text +renderItem TypeDeclaration { typename = moduleName + , type' = ty + } = + renderType ty + where + renderType :: Type -> TL.Text + renderType EnumType { members = members' } = + renderMarkup [compileText| +pub enum #{ toRustIdentifier I.toPascalCaseText $ facialName moduleName } { +%{ forall EnumMember memberName _ <- toList members' } + #{ toRustIdentifier I.toPascalCaseText $ facialName memberName }, +%{ endforall } +} +|] + renderType _ = TL.empty +renderItem _ = TL.empty diff --git a/src/Nirum/Targets/Rust/ModuleTree.hs b/src/Nirum/Targets/Rust/ModuleTree.hs new file mode 100644 index 0000000..1592311 --- /dev/null +++ b/src/Nirum/Targets/Rust/ModuleTree.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE OverloadedLists, TypeSynonymInstances #-} +module Nirum.Targets.Rust.ModuleTree ( RustModule ( RustModule + , filePath + , modPath + , children + ) + , buildRustModuleList + ) where + +import Data.List +import qualified Data.Text as T +import Data.Tree + +import GHC.Exts (IsList (toList)) + +import System.FilePath (joinPath) + +import Nirum.Constructs.Identifier +import Nirum.Constructs.ModulePath (ModulePath) +import Nirum.Targets.Rust.Keyword + +data UnpackedModule = UnpackedModule { unpackedModulePath :: [Identifier] + , originalModulePath :: ModulePath + } +data ModuleNode = ModuleNode { moduleName :: Identifier + , moduleNodePath :: Maybe ModulePath + } + +instance Eq UnpackedModule where + a == b = (unpackedModulePath a) == (unpackedModulePath b) +instance Ord UnpackedModule where + a <= b = (unpackedModulePath a) <= (unpackedModulePath b) + +type ModuleTree = Tree ModuleNode + +data RustModule = RustModule { filePath :: FilePath + , modPath :: Maybe ModulePath + , children :: [Identifier] + } + +-- type a = Identifier +-- type b = (Identifier, [UnpackedModule]) +-- moduleUnfolder :: b -> (a, [b]) +moduleUnfolder :: (ModuleNode, [UnpackedModule]) + -> (ModuleNode, [(ModuleNode, [UnpackedModule])]) +moduleUnfolder (ident, mps) = + (ident, groupByParent mps) + where + isParentEqual :: UnpackedModule -> UnpackedModule -> Bool + isParentEqual UnpackedModule { unpackedModulePath = (a:_) } + UnpackedModule { unpackedModulePath = (b:_) } = + a == b + isParentEqual _ _ = False + extractCommonParent :: [UnpackedModule] -> (ModuleNode, [UnpackedModule]) + extractCommonParent mps' = + ( ModuleNode { moduleName = commonParent + , moduleNodePath = maybeModulePath + } + , [ UnpackedModule { unpackedModulePath = x:xs + , originalModulePath = omn + } + | UnpackedModule { unpackedModulePath = x:xs + , originalModulePath = omn + } <- mps' + ] + ) + where + commonParent :: Identifier + commonParent = head $ unpackedModulePath $ head mps' + maybeModulePath :: Maybe ModulePath + maybeModulePath = + fmap originalModulePath $ + find (((==) 1) . length . unpackedModulePath) mps' + groupByParent :: [UnpackedModule] -> [(ModuleNode, [UnpackedModule])] + groupByParent = (map extractCommonParent) . (groupBy isParentEqual) . sort + +buildModuleTree :: [ModulePath] -> ModuleTree +buildModuleTree mps = + unfoldTree moduleUnfolder seed + where + srcModule :: ModuleNode + srcModule = ModuleNode { moduleName = "src" + , moduleNodePath = Nothing + } + seed :: (ModuleNode, [UnpackedModule]) + seed = ( srcModule + , [ UnpackedModule { unpackedModulePath = toList mp + , originalModulePath = mp + } + | mp <- mps + ] + ) + +toRustModuleList :: [String] -> ModuleTree -> [RustModule] +toRustModuleList baseDir Node { rootLabel = ModuleNode { moduleName = modName + , moduleNodePath = modPath' + } + , subForest = children' + } = + RustModule { filePath = joinPath identPath + , modPath = modPath' + , children = map (moduleName . rootLabel) children' + } : + (concat $ map (toRustModuleList identPath) children') + where + libOrMod :: String + libOrMod = case baseDir of + [] -> "lib.rs" + _ -> "mod.rs" + identPath :: [String] + identPath = + baseDir ++ + [T.unpack $ toRustIdentifier toSnakeCaseText modName] ++ + [libOrMod] + +buildRustModuleList :: [ModulePath] -> [RustModule] +buildRustModuleList = (toRustModuleList []) . buildModuleTree From bd0aa3adbfbdf5ab281b6127d867867d0714022d Mon Sep 17 00:00:00 2001 From: Eunchong Yu Date: Sun, 11 Mar 2018 19:04:33 +0900 Subject: [PATCH 3/6] Add some utility functions for ModulePath --- src/Nirum/Constructs/ModulePath.hs | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/src/Nirum/Constructs/ModulePath.hs b/src/Nirum/Constructs/ModulePath.hs index bad81cf..0f8579a 100644 --- a/src/Nirum/Constructs/ModulePath.hs +++ b/src/Nirum/Constructs/ModulePath.hs @@ -8,10 +8,14 @@ module Nirum.Constructs.ModulePath ( ModulePath ( ModuleName , fromIdentifiers , hierarchy , hierarchies + , isPrefixOf , replacePrefix + , root + , stripPrefix ) where import Data.Char (toLower) +import qualified Data.List as L import Data.Maybe (fromMaybe, mapMaybe) import GHC.Exts (IsList (Item, fromList, toList)) @@ -64,6 +68,9 @@ hierarchy m@(ModulePath parent _) = m `S.insert` hierarchy parent hierarchies :: S.Set ModulePath -> S.Set ModulePath hierarchies modulePaths = S.unions $ toList $ S.map hierarchy modulePaths +isPrefixOf :: ModulePath -> ModulePath -> Bool +a `isPrefixOf` b = toList a `L.isPrefixOf` toList b + replacePrefix :: ModulePath -> ModulePath -> ModulePath -> ModulePath replacePrefix from to path' | path' == from = to @@ -71,11 +78,22 @@ replacePrefix from to path' ModuleName {} -> path' ModulePath p n -> ModulePath (replacePrefix from to p) n +root :: ModulePath -> Identifier +root = head . toList + +stripPrefix :: ModulePath -> ModulePath -> Maybe ModulePath +stripPrefix a b = do + stripped <- L.stripPrefix (toList a) (toList b) + case stripped of + [] -> Nothing + xs -> Just $ fromList xs instance IsList ModulePath where type Item ModulePath = Identifier fromList identifiers = fromMaybe (error "ModulePath cannot be empty") (fromIdentifiers identifiers) - toList (ModuleName identifier) = [identifier] - toList (ModulePath path' identifier) = toList path' ++ [identifier] + toList mp = toList' mp [] + where + toList' (ModuleName identifier) xs = identifier:xs + toList' (ModulePath path' identifier) xs = toList' path' (identifier:xs) From dd1e0bc6bfb81f47274700ead25d0a4800e7c8eb Mon Sep 17 00:00:00 2001 From: Eunchong Yu Date: Sun, 11 Mar 2018 19:51:27 +0900 Subject: [PATCH 4/6] Make module path resolution simpler --- src/Nirum/Targets/Rust.hs | 31 +++++++- src/Nirum/Targets/Rust/ModuleTree.hs | 107 +-------------------------- test/Nirum/Targets/RustSpec.hs | 33 +++++++++ test/nirum_fixture/package.toml | 3 + 4 files changed, 68 insertions(+), 106 deletions(-) create mode 100644 test/Nirum/Targets/RustSpec.hs diff --git a/src/Nirum/Targets/Rust.hs b/src/Nirum/Targets/Rust.hs index 071ac97..00015c0 100644 --- a/src/Nirum/Targets/Rust.hs +++ b/src/Nirum/Targets/Rust.hs @@ -4,15 +4,20 @@ module Nirum.Targets.Rust ( Rust , Code , CompileError + , childModules ) where import qualified Data.Map.Strict as M +import Data.Maybe import qualified Data.SemVer as SV +import Data.Semigroup +import qualified Data.Set as S import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Text.Encoding (encodeUtf8) import Data.Text.Lazy (toStrict) import Data.Typeable (Typeable) +import System.FilePath import GHC.Exts (IsList (toList)) @@ -20,7 +25,7 @@ import Text.Blaze.Renderer.Text import Text.Heterocephalus (compileText) import qualified Nirum.Constructs.Identifier as I -import Nirum.Constructs.ModulePath (ModulePath) +import Nirum.Constructs.ModulePath import Nirum.Constructs.TypeDeclaration import Nirum.Package.Metadata import qualified Nirum.Package.ModuleSet as MS @@ -70,7 +75,7 @@ compilePackage' package = , Right $ toStrict $ TL.append (buildPrologue mod') - (buildBody (mp >>= resolveWithModulePath)) + (buildBody (resolveWithModulePath mp)) ) | mod'@RustModule { filePath = fileName , modPath = mp @@ -81,7 +86,27 @@ compilePackage' package = resolveWithModulePath :: ModulePath -> Maybe (BoundModule Rust) resolveWithModulePath mp = resolveBoundModule mp package modules' :: [RustModule] - modules' = buildRustModuleList [mp | (mp, _) <- MS.toAscList $ modules package] + modules' = libModule : [ RustModule { filePath = toFilePath $ toList mp + , modPath = mp + , children = childModules expanded' mp + } + | mp <- toList expanded' ] + expanded' = hierarchies $ S.fromList $ MS.keys $ modules package + libModule = RustModule { filePath = toFilePath [] + , modPath = ["lib"] + , children = S.map root expanded' + } + +childModules :: Foldable f => f ModulePath -> ModulePath -> S.Set I.Identifier +childModules modPaths base = fromMaybe mempty $ getOption $ foldMap f modPaths + where + f = Option . fmap (S.singleton . root) . stripPrefix base + +toFilePath :: [I.Identifier] -> FilePath +toFilePath [] = joinPath ["src", "lib.rs"] +toFilePath p = joinPath (["src"] ++ convert p ++ ["mod.rs"]) + where + convert = map (T.unpack . toRustIdentifier I.toSnakeCaseText) instance Target Rust where type CompileResult Rust = Code diff --git a/src/Nirum/Targets/Rust/ModuleTree.hs b/src/Nirum/Targets/Rust/ModuleTree.hs index 1592311..fa92d9c 100644 --- a/src/Nirum/Targets/Rust/ModuleTree.hs +++ b/src/Nirum/Targets/Rust/ModuleTree.hs @@ -4,114 +4,15 @@ module Nirum.Targets.Rust.ModuleTree ( RustModule ( RustModule , modPath , children ) - , buildRustModuleList ) where -import Data.List -import qualified Data.Text as T -import Data.Tree - -import GHC.Exts (IsList (toList)) - -import System.FilePath (joinPath) +import qualified Data.Set as S import Nirum.Constructs.Identifier import Nirum.Constructs.ModulePath (ModulePath) -import Nirum.Targets.Rust.Keyword - -data UnpackedModule = UnpackedModule { unpackedModulePath :: [Identifier] - , originalModulePath :: ModulePath - } -data ModuleNode = ModuleNode { moduleName :: Identifier - , moduleNodePath :: Maybe ModulePath - } - -instance Eq UnpackedModule where - a == b = (unpackedModulePath a) == (unpackedModulePath b) -instance Ord UnpackedModule where - a <= b = (unpackedModulePath a) <= (unpackedModulePath b) - -type ModuleTree = Tree ModuleNode data RustModule = RustModule { filePath :: FilePath - , modPath :: Maybe ModulePath - , children :: [Identifier] + , modPath :: ModulePath + , children :: S.Set Identifier } - --- type a = Identifier --- type b = (Identifier, [UnpackedModule]) --- moduleUnfolder :: b -> (a, [b]) -moduleUnfolder :: (ModuleNode, [UnpackedModule]) - -> (ModuleNode, [(ModuleNode, [UnpackedModule])]) -moduleUnfolder (ident, mps) = - (ident, groupByParent mps) - where - isParentEqual :: UnpackedModule -> UnpackedModule -> Bool - isParentEqual UnpackedModule { unpackedModulePath = (a:_) } - UnpackedModule { unpackedModulePath = (b:_) } = - a == b - isParentEqual _ _ = False - extractCommonParent :: [UnpackedModule] -> (ModuleNode, [UnpackedModule]) - extractCommonParent mps' = - ( ModuleNode { moduleName = commonParent - , moduleNodePath = maybeModulePath - } - , [ UnpackedModule { unpackedModulePath = x:xs - , originalModulePath = omn - } - | UnpackedModule { unpackedModulePath = x:xs - , originalModulePath = omn - } <- mps' - ] - ) - where - commonParent :: Identifier - commonParent = head $ unpackedModulePath $ head mps' - maybeModulePath :: Maybe ModulePath - maybeModulePath = - fmap originalModulePath $ - find (((==) 1) . length . unpackedModulePath) mps' - groupByParent :: [UnpackedModule] -> [(ModuleNode, [UnpackedModule])] - groupByParent = (map extractCommonParent) . (groupBy isParentEqual) . sort - -buildModuleTree :: [ModulePath] -> ModuleTree -buildModuleTree mps = - unfoldTree moduleUnfolder seed - where - srcModule :: ModuleNode - srcModule = ModuleNode { moduleName = "src" - , moduleNodePath = Nothing - } - seed :: (ModuleNode, [UnpackedModule]) - seed = ( srcModule - , [ UnpackedModule { unpackedModulePath = toList mp - , originalModulePath = mp - } - | mp <- mps - ] - ) - -toRustModuleList :: [String] -> ModuleTree -> [RustModule] -toRustModuleList baseDir Node { rootLabel = ModuleNode { moduleName = modName - , moduleNodePath = modPath' - } - , subForest = children' - } = - RustModule { filePath = joinPath identPath - , modPath = modPath' - , children = map (moduleName . rootLabel) children' - } : - (concat $ map (toRustModuleList identPath) children') - where - libOrMod :: String - libOrMod = case baseDir of - [] -> "lib.rs" - _ -> "mod.rs" - identPath :: [String] - identPath = - baseDir ++ - [T.unpack $ toRustIdentifier toSnakeCaseText modName] ++ - [libOrMod] - -buildRustModuleList :: [ModulePath] -> [RustModule] -buildRustModuleList = (toRustModuleList []) . buildModuleTree + deriving (Eq, Show) diff --git a/test/Nirum/Targets/RustSpec.hs b/test/Nirum/Targets/RustSpec.hs new file mode 100644 index 0000000..f5c1e26 --- /dev/null +++ b/test/Nirum/Targets/RustSpec.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE OverloadedLists, PartialTypeSignatures #-} +module Nirum.Targets.RustSpec where + +import qualified Data.Set as S +import Test.Hspec.Meta + +import Nirum.Constructs.ModulePath +import Nirum.Targets.Rust + + +spec :: Spec +spec = parallel $ + describe "childModules" $ do + specify "empty list" $ do + childModules S.empty ["a"] `shouldBe` [] + childModules S.empty ["a", "b"] `shouldBe` [] + specify "singleton" $ do + childModules ([["a"]] :: [ModulePath]) ["a"] `shouldBe` [] + childModules (S.singleton ["foo"]) ["foo"] `shouldBe` [] + childModules ([["foo"]] :: [ModulePath]) ["bar"] `shouldBe` [] + specify "simple" $ do + let input = [ ["a"] + , ["a", "b"] + , ["a", "c", "e"] + , ["b"] + , ["b", "c"] + , ["b", "d"] + ] :: [ModulePath] + childModules input ["a"] `shouldBe` ["b", "c"] + childModules input ["b"] `shouldBe` ["c", "d"] + childModules input ["c"] `shouldBe` [] + childModules input ["a", "b"] `shouldBe` [] + childModules input ["a", "c"] `shouldBe` ["e"] diff --git a/test/nirum_fixture/package.toml b/test/nirum_fixture/package.toml index a567475..fd0def3 100644 --- a/test/nirum_fixture/package.toml +++ b/test/nirum_fixture/package.toml @@ -14,3 +14,6 @@ name = "nirum_fixture" [targets.docs] title = "Fixtures for Nirum tests" + +[targets.rust] +name = "nirum_fixture" From ed460c192fa96f818dc672fbd800c03e9dcd33fb Mon Sep 17 00:00:00 2001 From: Eunchong Yu Date: Sun, 11 Mar 2018 20:42:47 +0900 Subject: [PATCH 5/6] Build filepath more natural --- src/Nirum/Targets/Rust.hs | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/src/Nirum/Targets/Rust.hs b/src/Nirum/Targets/Rust.hs index 00015c0..5736477 100644 --- a/src/Nirum/Targets/Rust.hs +++ b/src/Nirum/Targets/Rust.hs @@ -86,13 +86,9 @@ compilePackage' package = resolveWithModulePath :: ModulePath -> Maybe (BoundModule Rust) resolveWithModulePath mp = resolveBoundModule mp package modules' :: [RustModule] - modules' = libModule : [ RustModule { filePath = toFilePath $ toList mp - , modPath = mp - , children = childModules expanded' mp - } - | mp <- toList expanded' ] + modules' = libModule : map (toRustModule expanded') (toList expanded') expanded' = hierarchies $ S.fromList $ MS.keys $ modules package - libModule = RustModule { filePath = toFilePath [] + libModule = RustModule { filePath = toFilePath True ["lib"] , modPath = ["lib"] , children = S.map root expanded' } @@ -102,11 +98,21 @@ childModules modPaths base = fromMaybe mempty $ getOption $ foldMap f modPaths where f = Option . fmap (S.singleton . root) . stripPrefix base -toFilePath :: [I.Identifier] -> FilePath -toFilePath [] = joinPath ["src", "lib.rs"] -toFilePath p = joinPath (["src"] ++ convert p ++ ["mod.rs"]) +toFilePath :: Bool -> ModulePath -> FilePath +toFilePath isLeaf p = joinPath ("src" : converted) ++ ".rs" where - convert = map (T.unpack . toRustIdentifier I.toSnakeCaseText) + convert = map (toRustIdentifier I.toSnakeCaseText) . toList + converted = map T.unpack $ convert p ++ (if isLeaf then [] else ["mod"]) + +toRustModule :: Foldable f => f ModulePath -> ModulePath -> RustModule +toRustModule modPaths mp = RustModule { filePath = filePath' + , modPath = mp + , children = children' + } + where + children' = childModules modPaths mp + isLeaf = S.null children' + filePath' = toFilePath isLeaf mp instance Target Rust where type CompileResult Rust = Code From bc148ee2fa9136c2be8d78e2818e34e93913f3dc Mon Sep 17 00:00:00 2001 From: Wonwoo Choi Date: Sat, 12 May 2018 17:45:21 +0900 Subject: [PATCH 6/6] Hide Nirum.Constructs.ModulePath.isPrefixOf at Python codegen --- src/Nirum/Targets/Python/CodeGen.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Nirum/Targets/Python/CodeGen.hs b/src/Nirum/Targets/Python/CodeGen.hs index 8c655c1..3600f40 100644 --- a/src/Nirum/Targets/Python/CodeGen.hs +++ b/src/Nirum/Targets/Python/CodeGen.hs @@ -46,7 +46,7 @@ import Data.Text hiding (empty) import qualified Nirum.CodeGen import Nirum.Constructs.Identifier -import Nirum.Constructs.ModulePath +import Nirum.Constructs.ModulePath hiding (isPrefixOf) import Nirum.Constructs.Name minimumRuntime :: Version