{-# LANGUAGE LambdaCase #-}

module Jikka.Common.Name where

import Data.List
import Data.Maybe
import Text.Read

type OccName = Maybe String

type NameFlavour = Maybe Int

toFlavouredName :: String -> (OccName, NameFlavour)
toFlavouredName :: String -> (OccName, NameFlavour)
toFlavouredName = \case
  String
"_" -> (OccName
forall a. Maybe a
Nothing, NameFlavour
forall a. Maybe a
Nothing)
  String
s -> case Char -> String -> NameFlavour
forall a. Eq a => a -> [a] -> NameFlavour
elemIndex Char
'$' String
s of
    NameFlavour
Nothing -> (String -> OccName
forall a. a -> Maybe a
Just String
s, NameFlavour
forall a. Maybe a
Nothing)
    Just Int
i ->
      let (String
occ, String
flavour) = Int -> String -> (String, String)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i String
s
          occ' :: OccName
occ' = if String
occ String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then OccName
forall a. Maybe a
Nothing else String -> OccName
forall a. a -> Maybe a
Just String
occ
          flavour' :: Int
flavour' = case String -> NameFlavour
forall a. Read a => String -> Maybe a
readMaybe (String -> String
forall a. [a] -> [a]
tail String
flavour) of
            NameFlavour
Nothing -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"Jikka.Common.Name.toFlavouredName: invalid flavoured name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
            Just Int
i -> Int
i
       in (OccName
occ', Int -> NameFlavour
forall a. a -> Maybe a
Just Int
flavour')

formatFlavouredName :: OccName -> NameFlavour -> String
formatFlavouredName :: OccName -> NameFlavour -> String
formatFlavouredName OccName
occ NameFlavour
flavour = case (OccName
occ, NameFlavour
flavour) of
  (OccName
Nothing, NameFlavour
Nothing) -> String
"_"
  (OccName, NameFlavour)
_ -> String -> OccName -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" OccName
occ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> (Int -> String) -> NameFlavour -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((Char
'$' Char -> String -> String
forall a. a -> [a] -> [a]
:) (String -> String) -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) NameFlavour
flavour

data NameHint
  = LocalNameHint
  | LocalArgumentNameHint
  | LoopCounterNameHint
  | ConstantNameHint
  | FunctionNameHint
  | ArgumentNameHint
  | AdHocNameHint String
  deriving (NameHint -> NameHint -> Bool
(NameHint -> NameHint -> Bool)
-> (NameHint -> NameHint -> Bool) -> Eq NameHint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameHint -> NameHint -> Bool
$c/= :: NameHint -> NameHint -> Bool
== :: NameHint -> NameHint -> Bool
$c== :: NameHint -> NameHint -> Bool
Eq, Eq NameHint
Eq NameHint
-> (NameHint -> NameHint -> Ordering)
-> (NameHint -> NameHint -> Bool)
-> (NameHint -> NameHint -> Bool)
-> (NameHint -> NameHint -> Bool)
-> (NameHint -> NameHint -> Bool)
-> (NameHint -> NameHint -> NameHint)
-> (NameHint -> NameHint -> NameHint)
-> Ord NameHint
NameHint -> NameHint -> Bool
NameHint -> NameHint -> Ordering
NameHint -> NameHint -> NameHint
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NameHint -> NameHint -> NameHint
$cmin :: NameHint -> NameHint -> NameHint
max :: NameHint -> NameHint -> NameHint
$cmax :: NameHint -> NameHint -> NameHint
>= :: NameHint -> NameHint -> Bool
$c>= :: NameHint -> NameHint -> Bool
> :: NameHint -> NameHint -> Bool
$c> :: NameHint -> NameHint -> Bool
<= :: NameHint -> NameHint -> Bool
$c<= :: NameHint -> NameHint -> Bool
< :: NameHint -> NameHint -> Bool
$c< :: NameHint -> NameHint -> Bool
compare :: NameHint -> NameHint -> Ordering
$ccompare :: NameHint -> NameHint -> Ordering
$cp1Ord :: Eq NameHint
Ord, Int -> NameHint -> String -> String
[NameHint] -> String -> String
NameHint -> String
(Int -> NameHint -> String -> String)
-> (NameHint -> String)
-> ([NameHint] -> String -> String)
-> Show NameHint
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [NameHint] -> String -> String
$cshowList :: [NameHint] -> String -> String
show :: NameHint -> String
$cshow :: NameHint -> String
showsPrec :: Int -> NameHint -> String -> String
$cshowsPrec :: Int -> NameHint -> String -> String
Show, ReadPrec [NameHint]
ReadPrec NameHint
Int -> ReadS NameHint
ReadS [NameHint]
(Int -> ReadS NameHint)
-> ReadS [NameHint]
-> ReadPrec NameHint
-> ReadPrec [NameHint]
-> Read NameHint
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NameHint]
$creadListPrec :: ReadPrec [NameHint]
readPrec :: ReadPrec NameHint
$creadPrec :: ReadPrec NameHint
readList :: ReadS [NameHint]
$creadList :: ReadS [NameHint]
readsPrec :: Int -> ReadS NameHint
$creadsPrec :: Int -> ReadS NameHint
Read)