Skip to content

Commit 2770d49

Browse files
tirr-ctirr-c
authored
Merge pull request #1 from Kroisse/rust-target
Replace module resolution algorithm
2 parents 4659c74 + 6e2a22d commit 2770d49

File tree

5 files changed

+93
-108
lines changed

5 files changed

+93
-108
lines changed

‎src/Nirum/Constructs/ModulePath.hs

Lines changed: 20 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8,10 +8,14 @@ module Nirum.Constructs.ModulePath ( ModulePath ( ModuleName
88
, fromIdentifiers
99
, hierarchy
1010
, hierarchies
11+
, isPrefixOf
1112
, replacePrefix
13+
, root
14+
, stripPrefix
1215
) where
1316

1417
import Data.Char (toLower)
18+
import qualified Data.List as L
1519
import Data.Maybe (fromMaybe, mapMaybe)
1620
import GHC.Exts (IsList (Item, fromList, toList))
1721

@@ -64,18 +68,32 @@ hierarchy m@(ModulePath parent _) = m `S.insert` hierarchy parent
6468
hierarchies :: S.Set ModulePath -> S.Set ModulePath
6569
hierarchies modulePaths = S.unions $ toList $ S.map hierarchy modulePaths
6670

71+
isPrefixOf :: ModulePath -> ModulePath -> Bool
72+
a `isPrefixOf` b = toList a `L.isPrefixOf` toList b
73+
6774
replacePrefix :: ModulePath -> ModulePath -> ModulePath -> ModulePath
6875
replacePrefix from to path'
6976
| path' == from = to
7077
| otherwise = case path' of
7178
ModuleName {} -> path'
7279
ModulePath p n -> ModulePath (replacePrefix from to p) n
7380

81+
root :: ModulePath -> Identifier
82+
root = head . toList
83+
84+
stripPrefix :: ModulePath -> ModulePath -> Maybe ModulePath
85+
stripPrefix a b = do
86+
stripped <- L.stripPrefix (toList a) (toList b)
87+
case stripped of
88+
[] -> Nothing
89+
xs -> Just $ fromList xs
7490

7591
instance IsList ModulePath where
7692
type Item ModulePath = Identifier
7793
fromList identifiers =
7894
fromMaybe (error "ModulePath cannot be empty")
7995
(fromIdentifiers identifiers)
80-
toList (ModuleName identifier) = [identifier]
81-
toList (ModulePath path' identifier) = toList path' ++ [identifier]
96+
toList mp = toList' mp []
97+
where
98+
toList' (ModuleName identifier) xs = identifier:xs
99+
toList' (ModulePath path' identifier) xs = toList' path' (identifier:xs)

‎src/Nirum/Targets/Rust.hs

Lines changed: 34 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4,23 +4,28 @@
44
module Nirum.Targets.Rust ( Rust
55
, Code
66
, CompileError
7+
, childModules
78
) where
89

910
import qualified Data.Map.Strict as M
11+
import Data.Maybe
1012
import qualified Data.SemVer as SV
13+
import Data.Semigroup
14+
import qualified Data.Set as S
1115
import qualified Data.Text as T
1216
import qualified Data.Text.Lazy as TL
1317
import Data.Text.Encoding (encodeUtf8)
1418
import Data.Text.Lazy (toStrict)
1519
import Data.Typeable (Typeable)
20+
import System.FilePath
1621

1722
import GHC.Exts (IsList (toList))
1823

1924
import Text.Blaze.Renderer.Text
2025
import Text.Heterocephalus (compileText)
2126

2227
import qualified Nirum.Constructs.Identifier as I
23-
import Nirum.Constructs.ModulePath (ModulePath)
28+
import Nirum.Constructs.ModulePath
2429
import Nirum.Constructs.TypeDeclaration
2530
import Nirum.Package.Metadata
2631
import qualified Nirum.Package.ModuleSet as MS
@@ -70,7 +75,7 @@ compilePackage' package =
7075
, Right $
7176
toStrict $
7277
TL.append (buildPrologue mod')
73-
(buildBody (mp >>= resolveWithModulePath))
78+
(buildBody (resolveWithModulePath mp))
7479
)
7580
| mod'@RustModule { filePath = fileName
7681
, modPath = mp
@@ -81,7 +86,33 @@ compilePackage' package =
8186
resolveWithModulePath :: ModulePath -> Maybe (BoundModule Rust)
8287
resolveWithModulePath mp = resolveBoundModule mp package
8388
modules' :: [RustModule]
84-
modules' = buildRustModuleList [mp | (mp, _) <- MS.toAscList $ modules package]
89+
modules' = libModule : map (toRustModule expanded') (toList expanded')
90+
expanded' = hierarchies $ S.fromList $ MS.keys $ modules package
91+
libModule = RustModule { filePath = toFilePath True ["lib"]
92+
, modPath = ["lib"]
93+
, children = S.map root expanded'
94+
}
95+
96+
childModules :: Foldable f => f ModulePath -> ModulePath -> S.Set I.Identifier
97+
childModules modPaths base = fromMaybe mempty $ getOption $ foldMap f modPaths
98+
where
99+
f = Option . fmap (S.singleton . root) . stripPrefix base
100+
101+
toFilePath :: Bool -> ModulePath -> FilePath
102+
toFilePath isLeaf p = joinPath ("src" : converted) ++ ".rs"
103+
where
104+
convert = map (toRustIdentifier I.toSnakeCaseText) . toList
105+
converted = map T.unpack $ convert p ++ (if isLeaf then [] else ["mod"])
106+
107+
toRustModule :: Foldable f => f ModulePath -> ModulePath -> RustModule
108+
toRustModule modPaths mp = RustModule { filePath = filePath'
109+
, modPath = mp
110+
, children = children'
111+
}
112+
where
113+
children' = childModules modPaths mp
114+
isLeaf = S.null children'
115+
filePath' = toFilePath isLeaf mp
85116

86117
instance Target Rust where
87118
type CompileResult Rust = Code

‎src/Nirum/Targets/Rust/ModuleTree.hs

Lines changed: 4 additions & 103 deletions
Original file line numberDiff line numberDiff line change
@@ -4,114 +4,15 @@ module Nirum.Targets.Rust.ModuleTree ( RustModule ( RustModule
44
, modPath
55
, children
66
)
7-
, buildRustModuleList
87
) where
98

10-
import Data.List
11-
import qualified Data.Text as T
12-
import Data.Tree
13-
14-
import GHC.Exts (IsList (toList))
15-
16-
import System.FilePath (joinPath)
9+
import qualified Data.Set as S
1710

1811
import Nirum.Constructs.Identifier
1912
import Nirum.Constructs.ModulePath (ModulePath)
20-
import Nirum.Targets.Rust.Keyword
21-
22-
data UnpackedModule = UnpackedModule { unpackedModulePath :: [Identifier]
23-
, originalModulePath :: ModulePath
24-
}
25-
data ModuleNode = ModuleNode { moduleName :: Identifier
26-
, moduleNodePath :: Maybe ModulePath
27-
}
28-
29-
instance Eq UnpackedModule where
30-
a == b = (unpackedModulePath a) == (unpackedModulePath b)
31-
instance Ord UnpackedModule where
32-
a <= b = (unpackedModulePath a) <= (unpackedModulePath b)
33-
34-
type ModuleTree = Tree ModuleNode
3513

3614
data RustModule = RustModule { filePath :: FilePath
37-
, modPath :: Maybe ModulePath
38-
, children :: [Identifier]
15+
, modPath :: ModulePath
16+
, children :: S.Set Identifier
3917
}
40-
41-
-- type a = Identifier
42-
-- type b = (Identifier, [UnpackedModule])
43-
-- moduleUnfolder :: b -> (a, [b])
44-
moduleUnfolder :: (ModuleNode, [UnpackedModule])
45-
-> (ModuleNode, [(ModuleNode, [UnpackedModule])])
46-
moduleUnfolder (ident, mps) =
47-
(ident, groupByParent mps)
48-
where
49-
isParentEqual :: UnpackedModule -> UnpackedModule -> Bool
50-
isParentEqual UnpackedModule { unpackedModulePath = (a:_) }
51-
UnpackedModule { unpackedModulePath = (b:_) } =
52-
a == b
53-
isParentEqual _ _ = False
54-
extractCommonParent :: [UnpackedModule] -> (ModuleNode, [UnpackedModule])
55-
extractCommonParent mps' =
56-
( ModuleNode { moduleName = commonParent
57-
, moduleNodePath = maybeModulePath
58-
}
59-
, [ UnpackedModule { unpackedModulePath = x:xs
60-
, originalModulePath = omn
61-
}
62-
| UnpackedModule { unpackedModulePath = x:xs
63-
, originalModulePath = omn
64-
} <- mps'
65-
]
66-
)
67-
where
68-
commonParent :: Identifier
69-
commonParent = head $ unpackedModulePath $ head mps'
70-
maybeModulePath :: Maybe ModulePath
71-
maybeModulePath =
72-
fmap originalModulePath $
73-
find (((==) 1) . length . unpackedModulePath) mps'
74-
groupByParent :: [UnpackedModule] -> [(ModuleNode, [UnpackedModule])]
75-
groupByParent = (map extractCommonParent) . (groupBy isParentEqual) . sort
76-
77-
buildModuleTree :: [ModulePath] -> ModuleTree
78-
buildModuleTree mps =
79-
unfoldTree moduleUnfolder seed
80-
where
81-
srcModule :: ModuleNode
82-
srcModule = ModuleNode { moduleName = "src"
83-
, moduleNodePath = Nothing
84-
}
85-
seed :: (ModuleNode, [UnpackedModule])
86-
seed = ( srcModule
87-
, [ UnpackedModule { unpackedModulePath = toList mp
88-
, originalModulePath = mp
89-
}
90-
| mp <- mps
91-
]
92-
)
93-
94-
toRustModuleList :: [String] -> ModuleTree -> [RustModule]
95-
toRustModuleList baseDir Node { rootLabel = ModuleNode { moduleName = modName
96-
, moduleNodePath = modPath'
97-
}
98-
, subForest = children'
99-
} =
100-
RustModule { filePath = joinPath identPath
101-
, modPath = modPath'
102-
, children = map (moduleName . rootLabel) children'
103-
} :
104-
(concat $ map (toRustModuleList identPath) children')
105-
where
106-
libOrMod :: String
107-
libOrMod = case baseDir of
108-
[] -> "lib.rs"
109-
_ -> "mod.rs"
110-
identPath :: [String]
111-
identPath =
112-
baseDir ++
113-
[T.unpack $ toRustIdentifier toSnakeCaseText modName] ++
114-
[libOrMod]
115-
116-
buildRustModuleList :: [ModulePath] -> [RustModule]
117-
buildRustModuleList = (toRustModuleList []) . buildModuleTree
18+
deriving (Eq, Show)

‎test/Nirum/Targets/RustSpec.hs

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
{-# LANGUAGE OverloadedLists, PartialTypeSignatures #-}
2+
module Nirum.Targets.RustSpec where
3+
4+
import qualified Data.Set as S
5+
import Test.Hspec.Meta
6+
7+
import Nirum.Constructs.ModulePath
8+
import Nirum.Targets.Rust
9+
10+
11+
spec :: Spec
12+
spec = parallel $
13+
describe "childModules" $ do
14+
specify "empty list" $ do
15+
childModules S.empty ["a"] `shouldBe` []
16+
childModules S.empty ["a", "b"] `shouldBe` []
17+
specify "singleton" $ do
18+
childModules ([["a"]] :: [ModulePath]) ["a"] `shouldBe` []
19+
childModules (S.singleton ["foo"]) ["foo"] `shouldBe` []
20+
childModules ([["foo"]] :: [ModulePath]) ["bar"] `shouldBe` []
21+
specify "simple" $ do
22+
let input = [ ["a"]
23+
, ["a", "b"]
24+
, ["a", "c", "e"]
25+
, ["b"]
26+
, ["b", "c"]
27+
, ["b", "d"]
28+
] :: [ModulePath]
29+
childModules input ["a"] `shouldBe` ["b", "c"]
30+
childModules input ["b"] `shouldBe` ["c", "d"]
31+
childModules input ["c"] `shouldBe` []
32+
childModules input ["a", "b"] `shouldBe` []
33+
childModules input ["a", "c"] `shouldBe` ["e"]

‎test/nirum_fixture/package.toml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,3 +12,5 @@ email = "[email protected]"
1212
name = "nirum_fixture"
1313
[targets.python.renames]
1414
"renames.test" = "renamed"
15+
[targets.rust]
16+
name = "nirum_fixture"

0 commit comments

Comments
 (0)