-- | Parsers for unit/module identifiers
module GHC.Unit.Parser
   ( parseUnit
   , parseIndefUnitId
   , parseHoleyModule
   , parseModSubst
   )
where

import GHC.Prelude

import GHC.Unit.Types
import GHC.Unit.Module.Name
import GHC.Data.FastString

import qualified Text.ParserCombinators.ReadP as Parse
import Text.ParserCombinators.ReadP (ReadP, (<++))
import Data.Char (isAlphaNum)

parseUnit :: ReadP Unit
parseUnit :: ReadP Unit
parseUnit = ReadP Unit
parseVirtUnitId ReadP Unit -> ReadP Unit -> ReadP Unit
forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP Unit
parseDefUnitId
  where
    parseVirtUnitId :: ReadP Unit
parseVirtUnitId = do
        IndefUnitId
uid   <- ReadP IndefUnitId
parseIndefUnitId
        [(ModuleName, Module)]
insts <- ReadP [(ModuleName, Module)]
parseModSubst
        Unit -> ReadP Unit
forall (m :: * -> *) a. Monad m => a -> m a
return (IndefUnitId -> [(ModuleName, Module)] -> Unit
forall u.
IsUnitId u =>
Indefinite u -> [(ModuleName, GenModule (GenUnit u))] -> GenUnit u
mkVirtUnit IndefUnitId
uid [(ModuleName, Module)]
insts)
    parseDefUnitId :: ReadP Unit
parseDefUnitId = do
        UnitId
s <- ReadP UnitId
parseUnitId
        Unit -> ReadP Unit
forall (m :: * -> *) a. Monad m => a -> m a
return (Definite UnitId -> Unit
forall uid. Definite uid -> GenUnit uid
RealUnit (UnitId -> Definite UnitId
forall unit. unit -> Definite unit
Definite UnitId
s))

parseUnitId :: ReadP UnitId
parseUnitId :: ReadP UnitId
parseUnitId = do
   String
s <- (Char -> Bool) -> ReadP String
Parse.munch1 (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"-_.+")
   UnitId -> ReadP UnitId
forall (m :: * -> *) a. Monad m => a -> m a
return (FastString -> UnitId
UnitId (String -> FastString
mkFastString String
s))

parseIndefUnitId :: ReadP IndefUnitId
parseIndefUnitId :: ReadP IndefUnitId
parseIndefUnitId = do
   UnitId
uid <- ReadP UnitId
parseUnitId
   IndefUnitId -> ReadP IndefUnitId
forall (m :: * -> *) a. Monad m => a -> m a
return (UnitId -> IndefUnitId
forall unit. unit -> Indefinite unit
Indefinite UnitId
uid)

parseHoleyModule :: ReadP Module
parseHoleyModule :: ReadP Module
parseHoleyModule = ReadP Module
forall {uid}. ReadP (GenModule (GenUnit uid))
parseModuleVar ReadP Module -> ReadP Module -> ReadP Module
forall a. ReadP a -> ReadP a -> ReadP a
<++ ReadP Module
parseModule
    where
      parseModuleVar :: ReadP (GenModule (GenUnit uid))
parseModuleVar = do
        Char
_ <- Char -> ReadP Char
Parse.char Char
'<'
        ModuleName
modname <- ReadP ModuleName
parseModuleName
        Char
_ <- Char -> ReadP Char
Parse.char Char
'>'
        GenModule (GenUnit uid) -> ReadP (GenModule (GenUnit uid))
forall (m :: * -> *) a. Monad m => a -> m a
return (GenUnit uid -> ModuleName -> GenModule (GenUnit uid)
forall unit. unit -> ModuleName -> GenModule unit
Module GenUnit uid
forall uid. GenUnit uid
HoleUnit ModuleName
modname)
      parseModule :: ReadP Module
parseModule = do
        Unit
uid <- ReadP Unit
parseUnit
        Char
_ <- Char -> ReadP Char
Parse.char Char
':'
        ModuleName
modname <- ReadP ModuleName
parseModuleName
        Module -> ReadP Module
forall (m :: * -> *) a. Monad m => a -> m a
return (Unit -> ModuleName -> Module
forall unit. unit -> ModuleName -> GenModule unit
Module Unit
uid ModuleName
modname)

parseModSubst :: ReadP [(ModuleName, Module)]
parseModSubst :: ReadP [(ModuleName, Module)]
parseModSubst = ReadP Char
-> ReadP Char
-> ReadP [(ModuleName, Module)]
-> ReadP [(ModuleName, Module)]
forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
Parse.between (Char -> ReadP Char
Parse.char Char
'[') (Char -> ReadP Char
Parse.char Char
']')
      (ReadP [(ModuleName, Module)] -> ReadP [(ModuleName, Module)])
-> (ReadP (ModuleName, Module) -> ReadP [(ModuleName, Module)])
-> ReadP (ModuleName, Module)
-> ReadP [(ModuleName, Module)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReadP (ModuleName, Module)
 -> ReadP Char -> ReadP [(ModuleName, Module)])
-> ReadP Char
-> ReadP (ModuleName, Module)
-> ReadP [(ModuleName, Module)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReadP (ModuleName, Module)
-> ReadP Char -> ReadP [(ModuleName, Module)]
forall a sep. ReadP a -> ReadP sep -> ReadP [a]
Parse.sepBy (Char -> ReadP Char
Parse.char Char
',')
      (ReadP (ModuleName, Module) -> ReadP [(ModuleName, Module)])
-> ReadP (ModuleName, Module) -> ReadP [(ModuleName, Module)]
forall a b. (a -> b) -> a -> b
$ do ModuleName
k <- ReadP ModuleName
parseModuleName
           Char
_ <- Char -> ReadP Char
Parse.char Char
'='
           Module
v <- ReadP Module
parseHoleyModule
           (ModuleName, Module) -> ReadP (ModuleName, Module)
forall (m :: * -> *) a. Monad m => a -> m a
return (ModuleName
k, Module
v)