Add Nirum.Constructs.ModulePath.hierarchy

nirum-lang · Mar 7, 2017 · f8072b8 · f8072b8
1 parent 5464d7e
commit f8072b8
Show file tree

Hide file tree

Showing 2 changed files with 17 additions and 0 deletions.
diff --git a/src/Nirum/Constructs/ModulePath.hs b/src/Nirum/Constructs/ModulePath.hs
@@ -7,6 +7,7 @@ module Nirum.Constructs.ModulePath ( ModulePath ( ModuleName
                                    , ancestors
                                    , fromFilePath
                                    , fromIdentifiers
+                                   , hierarchy
                                    ) where
 
 import Data.Char (toLower)
@@ -66,3 +67,10 @@ instance IsList ModulePath where
                   (fromIdentifiers identifiers)
     toList (ModuleName identifier) = [identifier]
     toList (ModulePath path' identifier) = toList path' ++ [identifier]
+
+hierarchy :: ModulePath -> S.Set [Identifier]
+hierarchy modulePath' = S.fromList $ toPathList modulePath'
+  where
+    toPathList :: ModulePath -> [[Identifier]]
+    toPathList m@(ModulePath path' _) = toList m : toPathList path'
+    toPathList (ModuleName identifier) = [[identifier]]
diff --git a/test/Nirum/Constructs/ModulePathSpec.hs b/test/Nirum/Constructs/ModulePathSpec.hs
@@ -3,8 +3,10 @@ module Nirum.Constructs.ModulePathSpec where
 
 import Control.Exception (evaluate)
 import Data.List (sort)
+import Data.Maybe (fromJust)
 import GHC.Exts (IsList (fromList, toList))
 
+import qualified Data.Set as S
 import System.FilePath ((</>))
 import Test.Hspec.Meta
 
@@ -13,6 +15,7 @@ import Nirum.Constructs.ModulePath ( ModulePath (ModuleName, ModulePath)
                                    , ancestors
                                    , fromFilePath
                                    , fromIdentifiers
+                                   , hierarchy
                                    )
 
 spec :: Spec
@@ -82,3 +85,9 @@ spec =
                 fooBarBaz2 `shouldNotSatisfy` (<= fooBarBaz)
                 sort [["abc"], foo, fooBar, fooBarBaz, fooBarBaz2]
                     `shouldBe` [["abc"], foo, fooBar, fooBarBaz, fooBarBaz2]
+        specify "hierarchy" $ do
+            let foo' = fromJust $ fromIdentifiers ["foo", "bar", "baz"]
+            hierarchy foo' `shouldBe` S.fromList [ ["foo", "bar", "baz"]
+                                                 , ["foo", "bar"]
+                                                 , ["foo"]
+                                                 ]