module Language.PureScript.Docs.ParseAndBookmark
( parseAndBookmark
) where
import Prelude ()
import Prelude.Compat
import qualified Data.Map as M
import Control.Arrow (first)
import Control.Monad.Error.Class (MonadError(..))
import Control.Monad.IO.Class (MonadIO(..))
import Web.Bower.PackageMeta (PackageName)
import qualified Language.PureScript as P
import Language.PureScript.Docs.Types
import Language.PureScript.Docs.Convert (collectBookmarks)
parseAndBookmark ::
(Functor m, Applicative m, MonadError P.MultipleErrors m, MonadIO m) =>
[FilePath]
-> [(PackageName, FilePath)]
-> m ([InPackage P.Module], [Bookmark])
parseAndBookmark inputFiles depsFiles = do
inputFiles' <- traverse (parseAs Local) inputFiles
depsFiles' <- traverse (\(pkgName, f) -> parseAs (FromDep pkgName) f) depsFiles
addBookmarks <$> parseFiles (inputFiles' ++ depsFiles')
parseFiles ::
(MonadError P.MultipleErrors m, MonadIO m) =>
[(FileInfo, FilePath)]
-> m [(FileInfo, P.Module)]
parseFiles =
throwLeft . P.parseModulesFromFiles fileInfoToString
addBookmarks ::
[(FileInfo, P.Module)]
-> ([InPackage P.Module], [Bookmark])
addBookmarks msInfo =
let
msDeps = getDepsModuleNames (map (\(fp, m) -> (,m) <$> fp) msInfo)
msPackages = map (addPackage msDeps . snd) msInfo
bookmarks = concatMap collectBookmarks msPackages
in
(msPackages, bookmarks)
throwLeft :: (MonadError l m) => Either l r -> m r
throwLeft = either throwError return
type FileInfo = InPackage FilePath
fileInfoToString :: FileInfo -> FilePath
fileInfoToString (Local fn) = fn
fileInfoToString (FromDep _ fn) = fn
parseFile :: FilePath -> IO (FilePath, String)
parseFile input' = (,) input' <$> readFile input'
parseAs :: (Functor m, MonadIO m) => (FilePath -> a) -> FilePath -> m (a, String)
parseAs g = fmap (first g) . liftIO . parseFile
getDepsModuleNames :: [InPackage (FilePath, P.Module)] -> M.Map P.ModuleName PackageName
getDepsModuleNames = foldl go M.empty
where
go deps p = deps # case p of
Local _ -> id
FromDep pkgName (_, m) -> M.insert (P.getModuleName m) pkgName
(#) = flip ($)
addPackage :: M.Map P.ModuleName PackageName -> P.Module -> InPackage P.Module
addPackage depsModules m =
case M.lookup (P.getModuleName m) depsModules of
Just pkgName -> FromDep pkgName m
Nothing -> Local m