Merge pull request #83 from dahlia/package-metadata

Package metadata, the first phase

README.md

@@ -55,7 +55,7 @@ In order to compile a Nirum package (`examples/`) to a Python package:
 For more infomration, use `--help` option:
 
     $ nirum --help
-    Nirum Compiler 0.1.0
+    Nirum Compiler 0.3.0
 
     nirum [OPTIONS] DIR
 

examples/package.toml

@@ -0,0 +1 @@
+version = "0.3.0"

nirum.cabal

@@ -1,5 +1,5 @@
 name:                nirum
-version:             0.2.0
+version:             0.3.0
 synopsis:            IDL compiler and RPC/distributed object framework for
                      microservices
 description:         Nirum is an IDL compiler and RPC/distributed object
@@ -40,19 +40,28 @@ library
                  ,     Nirum.Constructs.TypeDeclaration
                  ,     Nirum.Constructs.TypeExpression
                  ,     Nirum.Package
+                 ,     Nirum.Package.Metadata
+                 ,     Nirum.Package.ModuleSet
                  ,     Nirum.Parser
                  ,     Nirum.Targets.Python
                  ,     Nirum.Version
   build-depends:       base                     >=4.7     && <5
                ,       containers               >=0.5.6.2 && <0.6
                ,       cmdargs                  >=0.10.14 && <0.11
                ,       directory                >=1.2.5   && <1.3
+               ,       email-validate           >=2.0.0   && <3.0.0
                ,       filepath                 >=1.4     && <1.5
+               ,       htoml                    >=1.0.0.0 && <1.1.0.0
                ,       interpolatedstring-perl6 >=1.0.0   && <1.1.0
-               ,       megaparsec               >=5       && <5.1
+               ,       megaparsec               >=5       && <5.2
                ,       mtl                      >=2.2.1   && <3
+               ,       parsec
+                       -- only for dealing with htoml's ParserError
                ,       semver                   >=0.3.0   && <1.0
                ,       text                     >=0.9.1.0 && <1.3
+               ,       unordered-containers
+                       -- only for dealing with htoml's data structures
+               ,       uri                      >=0.1     && <1.0
   hs-source-dirs:      src
   default-language:    Haskell2010
   default-extensions:  OverloadedStrings
@@ -91,6 +100,7 @@ test-suite spec
                ,       Nirum.Constructs.ServiceSpec
                ,       Nirum.Constructs.TypeDeclarationSpec
                ,       Nirum.Constructs.TypeExpressionSpec
+               ,       Nirum.Package.ModuleSetSpec
                ,       Nirum.PackageSpec
                ,       Nirum.ParserSpec
                ,       Nirum.Targets.PythonSpec
@@ -101,14 +111,17 @@ test-suite spec
   build-depends:       base                     >=4.7     && <5
                ,       containers               >=0.5.6.2 && <0.6
                ,       directory
+               ,       email-validate           >=2.0.0   && <3.0.0
                ,       filepath                 >=1.4     && <1.5
                ,       hspec
                ,       hspec-core
                ,       hspec-meta
                ,       interpolatedstring-perl6 >=1.0.0   && <1.1.0
-               ,       megaparsec               >=5       && <5.1
+               ,       megaparsec               >=5       && <5.2
                ,       mtl                      >=2.2.1   && <3
                ,       nirum
+               ,       parsec
+                       -- only for dealing with htoml's ParserError
                ,       process                  >=1.1     && <2
                ,       semigroups
                ,       semver                   >=0.3.0   && <1.0

src/Nirum/Cli.hs

@@ -35,14 +35,19 @@ import Text.Megaparsec.Pos (SourcePos(sourceLine, sourceColumn), unPos)
 import Nirum.Constructs (Construct(toCode))
 import Nirum.Constructs.Identifier (toText)
 import Nirum.Constructs.ModulePath (ModulePath)
-import Nirum.Package ( PackageError(ParseError, ImportError, ScanError)
-                     , ImportError ( CircularImportError
-                                   , MissingImportError
-                                   , MissingModulePathError
-                                   )
+import Nirum.Package ( PackageError ( ImportError
+                                    , MetadataError
+                                    , ParseError
+                                    , ScanError
+                                    )
                      , scanModules
                      , scanPackage
                      )
+import Nirum.Package.ModuleSet ( ImportError ( CircularImportError
+                                             , MissingImportError
+                                             , MissingModulePathError
+                                             )
+                               )
 import Nirum.Targets.Python (compilePackage)
 import Nirum.Version (versionString)
 
@@ -144,6 +149,7 @@ main' = do
 {importErrorsToPrettyMessage importErrors}
 |]
         Left (ScanError _ error') -> putStrLn [qq|Scan error: $error'|]
+        Left (MetadataError error') -> putStrLn [qq|Metadata error: $error'|]
         Right pkg -> writeFiles obj $ compilePackage pkg
 
 writeFiles :: FilePath -> M.Map FilePath (Either T.Text T.Text) -> IO ()

src/Nirum/Constructs/ModulePath.hs

@@ -23,7 +23,10 @@ import Nirum.Constructs.Identifier (Identifier, fromText)
 data ModulePath = ModulePath { path :: ModulePath
                              , moduleName :: Identifier }
                 | ModuleName { moduleName :: Identifier }
-                deriving (Eq, Ord, Show)
+                deriving (Eq, Show)
+
+instance Ord ModulePath where
+    a <= b = toList a <= toList b
 
 instance Construct ModulePath where
     toCode = intercalate "." . map toCode . toList

src/Nirum/Package.hs

@@ -1,22 +1,28 @@
 module Nirum.Package ( BoundModule(boundPackage, modulePath)
-                     , ImportError ( CircularImportError
-                                   , MissingImportError
-                                   , MissingModulePathError
-                                   )
-                     , Package(modules)
-                     , PackageError(ImportError, ParseError, ScanError)
-                     , TypeLookup(Imported, Local, Missing)
+                     , Package (Package, metadata, modules)
+                     , PackageError ( ImportError
+                                    , MetadataError
+                                    , ParseError
+                                    , ScanError
+                                    )
+                     , TypeLookup (Imported, Local, Missing)
                      , docs
                      , findInBoundModule
                      , lookupType
-                     , makePackage
                      , resolveBoundModule
                      , resolveModule
                      , scanModules
                      , scanPackage
                      , types
                      ) where
 
+import System.IO.Error (catchIOError)
+
+import Control.Monad.Except ( ExceptT
+                            , MonadError(throwError)
+                            , liftIO
+                            , runExceptT
+                            )
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 import System.Directory (doesDirectoryExist, listDirectory)
@@ -34,102 +40,49 @@ import Nirum.Constructs.TypeDeclaration ( Type
                                                           , type'
                                                           )
                                         )
+import Nirum.Package.Metadata ( Metadata
+                              , MetadataError
+                              , metadataPath
+                              , readFromPackage 
+                              )
+import qualified Nirum.Package.ModuleSet as MS
 import Nirum.Parser (ParseError, parseFile)
 
 -- | Represents a package which consists of modules.
-data Package = Package { modules :: M.Map ModulePath Mod.Module
+data Package = Package { metadata :: Metadata
+                       , modules :: MS.ModuleSet
                        } deriving (Eq, Ord, Show)
--- TODO: uri, version, dependencies
-
-data ImportError = CircularImportError [ModulePath]
-                 | MissingModulePathError ModulePath ModulePath
-                 | MissingImportError ModulePath ModulePath Identifier
-                 deriving (Eq, Ord, Show)
-
-makePackage :: M.Map ModulePath Mod.Module -> Either (S.Set ImportError) Package
-makePackage modules'
-    | S.null importErrors = Right package
-    | otherwise = Left importErrors
-  where
-    package :: Package
-    package = Package modules'
-    importErrors :: S.Set ImportError
-    importErrors = detectImportErrors package
 
 resolveModule :: ModulePath -> Package -> Maybe Mod.Module
-resolveModule path Package { modules = ms } = M.lookup path ms
+resolveModule path Package { modules = ms } = MS.lookup path ms
 
 resolveBoundModule :: ModulePath -> Package -> Maybe BoundModule
 resolveBoundModule path package =
     case resolveModule path package of
         Just _ -> Just $ BoundModule package path
         Nothing -> Nothing
 
-detectImportErrors :: Package -> S.Set ImportError
-detectImportErrors package = detectMissingImports package `S.union`
-                             detectCircularImports package
-
-detectMissingImports :: Package -> S.Set ImportError
-detectMissingImports package@Package { modules = ms } =
-    S.fromList [e | (path, module') <- M.toList ms, e <- detect path module']
-  where
-    detect :: ModulePath -> Mod.Module -> [ImportError]
-    detect path module' =
-        [ e
-        | (path', idents) <- M.toList (Mod.imports module')
-        , e <- case resolveModule path' package of
-                Nothing -> [MissingModulePathError path path']
-                Just (Mod.Module decls _) ->
-                    [ e
-                    | i <- S.toList idents
-                    , e <- case DS.lookup i decls of
-                        Just TypeDeclaration {} -> []
-                        Just ServiceDeclaration {} -> []
-                        Just Import {} -> [MissingImportError path path' i]
-                        Nothing -> [MissingImportError path path' i]
-                    ]
-        ]
-
-detectCircularImports :: Package -> S.Set ImportError
-detectCircularImports Package { modules = ms } =
-    S.fromList [e | path <- M.keys ms, e <- detect path []]
-  where
-    moduleImports :: M.Map ModulePath (S.Set ModulePath)
-    moduleImports =
-        M.fromList [ (path, M.keysSet $ Mod.imports module')
-                   | (path, module') <- M.toList ms
-                   ]
-    detect :: ModulePath -> [ModulePath] -> [ImportError]
-    detect path reversedCycle
-        | path `elem` reversedCycle =
-            [CircularImportError $ reverse reversedCycle']
-        | otherwise =
-            case M.lookup path moduleImports of
-                Just paths -> [ e
-                              | path' <- S.toList paths
-                              , e <- detect path' reversedCycle'
-                              ]
-                Nothing -> []
-      where
-        reversedCycle' :: [ModulePath]
-        reversedCycle' = path : reversedCycle
-
 data PackageError = ScanError FilePath IOError
                   | ParseError ModulePath ParseError
-                  | ImportError (S.Set ImportError)
+                  | ImportError (S.Set MS.ImportError)
+                  | MetadataError MetadataError
                   deriving (Eq, Show)
 
 -- | Scan the given package path, and then return the read package.
 scanPackage :: FilePath -> IO (Either PackageError Package)
-scanPackage packagePath = do
-    modulePaths <- scanModules packagePath
-    -- FIXME: catch IO errors
-    modules' <- mapM parseFile modulePaths
-    return $ case M.foldrWithKey excludeFailedParse (Right M.empty) modules' of
-        Right parsedModules -> case makePackage parsedModules of
-            Right p -> Right p
-            Left errors -> Left $ ImportError errors
-        Left error' -> Left error'
+scanPackage packagePath = runExceptT $ do
+    metadataE <- catch (readFromPackage packagePath)
+                       (ScanError $ metadataPath packagePath)
+    metadata' <- case metadataE of
+        Right m -> return m
+        Left e -> throwError $ MetadataError e
+    modulePaths <- liftIO $ scanModules packagePath
+    modules' <- mapM (\p -> catch (parseFile p) $ ScanError p) modulePaths
+    case M.foldrWithKey excludeFailedParse (Right M.empty) modules' of
+        Right parsedModules -> case MS.fromMap parsedModules of
+            Right ms -> return $ Package metadata' ms
+            Left errors -> throwError $ ImportError errors
+        Left error' -> throwError error'
   where
     excludeFailedParse :: ModulePath
                        -> Either ParseError Mod.Module
@@ -139,6 +92,13 @@ scanPackage packagePath = do
     excludeFailedParse path (Left error') _ = Left $ ParseError path error'
     excludeFailedParse path (Right module') (Right map') =
         Right (M.insert path module' map')
+    catch :: IO a -> (IOError -> e) -> ExceptT e IO a
+    catch op onError = do
+        result <- liftIO $ catchIOError (fmap Right op)
+                                        (return . Left . onError)
+        case result of
+            Left err -> throwError err
+            Right val -> return val
 
 -- | Scan the given path recursively, and then return the map of
 -- detected module paths.
@@ -176,7 +136,7 @@ findInBoundModule valueWhenExist valueWhenNotExist
                   BoundModule { boundPackage = Package { modules = ms }
                               , modulePath = path
                               } =
-    case M.lookup path ms of
+    case MS.lookup path ms of
         Nothing -> valueWhenNotExist
         Just mod' -> valueWhenExist mod'