module GHC.Runtime.Eval.Utils where

import GHC.Prelude
import Data.Char
import Data.List (elemIndices)

-- | Split up a string with an eventually qualified declaration name into 3 components
--
--   1. module name
--   2. top-level decl
--   3. full-name of the eventually nested decl, but without module qualification
--
-- === __Example__
--
-- @
--     "foo"           = ("", "foo", "foo")
--     "A.B.C.foo"     = ("A.B.C", "foo", "foo")
--     "M.N.foo.bar"   = ("M.N", "foo", "foo.bar")
-- @
splitIdent :: String -> (String, String, String)
splitIdent :: String -> (String, String, String)
splitIdent [] = (String
"", String
"", String
"")
splitIdent inp :: String
inp@(Char
a : String
_)
    | (Char -> Bool
isUpper Char
a) = case [Int]
fixs of
        []            -> (String
inp, String
"", String
"")
        (Int
i1 : [] )    -> (Int -> String
upto Int
i1, Int -> String
from Int
i1, Int -> String
from Int
i1)
        (Int
i1 : Int
i2 : [Int]
_) -> (Int -> String
upto Int
i1, Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
i2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i1 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> String
from Int
i1), Int -> String
from Int
i1)
    | Bool
otherwise = case [Int]
ixs of
        []            -> (String
"", String
inp, String
inp)
        (Int
i1 : [Int]
_)      -> (String
"", Int -> String
upto Int
i1, String
inp)
  where
    ixs :: [Int]
ixs = Char -> String -> [Int]
forall a. Eq a => a -> [a] -> [Int]
elemIndices Char
'.' String
inp        -- indices of '.' in whole input
    fixs :: [Int]
fixs = (Int -> Bool) -> [Int] -> [Int]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Int -> Bool
isNextUc [Int]
ixs    -- indices of '.' in function names              --
    isNextUc :: Int -> Bool
isNextUc Int
ix = Char -> Bool
isUpper (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ String
safeInp String -> Int -> Char
forall a. HasCallStack => [a] -> Int -> a
!! (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
    safeInp :: String
safeInp = String
inp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
    upto :: Int -> String
upto Int
i = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
i String
inp
    from :: Int -> String
from Int
i = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
inp

-- | Qualify an identifier name with a module name
--
-- @
-- combineModIdent "A" "foo"  =  "A.foo"
-- combineModIdent ""  "foo"  =  "foo"
-- @
combineModIdent :: String -> String -> String
combineModIdent :: String -> String -> String
combineModIdent String
mod String
ident
          | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
mod   = String
ident
          | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ident = String
mod
          | Bool
otherwise  = String
mod String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ident