-- |
-- Module      :  Cryptol.Utils.Ident
-- Copyright   :  (c) 2015-2016 Galois, Inc.
-- License     :  BSD3
-- Maintainer  :  cryptol@galois.com
-- Stability   :  provisional
-- Portability :  portable

{-# LANGUAGE DeriveGeneric, OverloadedStrings #-}

module Cryptol.Utils.Ident
  ( -- * Module names
    ModName
  , modNameToText
  , textToModName
  , modNameChunks
  , packModName
  , preludeName
  , interactiveName
  , noModuleName
  , exprModName

  , isParamInstModName
  , paramInstModName
  , notParamInstModName

    -- * Identifiers
  , Ident
  , packIdent
  , packInfix
  , unpackIdent
  , mkIdent
  , mkInfix
  , isInfixIdent
  , nullIdent
  , identText
  , modParamIdent

  ) where

import           Control.DeepSeq (NFData)
import           Data.Char (isSpace)
import           Data.List (unfoldr)
import qualified Data.Text as T
import           Data.String (IsString(..))
import           GHC.Generics (Generic)


-- | Module names are just text.
data ModName = ModName T.Text
  deriving (ModName -> ModName -> Bool
(ModName -> ModName -> Bool)
-> (ModName -> ModName -> Bool) -> Eq ModName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModName -> ModName -> Bool
$c/= :: ModName -> ModName -> Bool
== :: ModName -> ModName -> Bool
$c== :: ModName -> ModName -> Bool
Eq,Eq ModName
Eq ModName =>
(ModName -> ModName -> Ordering)
-> (ModName -> ModName -> Bool)
-> (ModName -> ModName -> Bool)
-> (ModName -> ModName -> Bool)
-> (ModName -> ModName -> Bool)
-> (ModName -> ModName -> ModName)
-> (ModName -> ModName -> ModName)
-> Ord ModName
ModName -> ModName -> Bool
ModName -> ModName -> Ordering
ModName -> ModName -> ModName
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 :: ModName -> ModName -> ModName
$cmin :: ModName -> ModName -> ModName
max :: ModName -> ModName -> ModName
$cmax :: ModName -> ModName -> ModName
>= :: ModName -> ModName -> Bool
$c>= :: ModName -> ModName -> Bool
> :: ModName -> ModName -> Bool
$c> :: ModName -> ModName -> Bool
<= :: ModName -> ModName -> Bool
$c<= :: ModName -> ModName -> Bool
< :: ModName -> ModName -> Bool
$c< :: ModName -> ModName -> Bool
compare :: ModName -> ModName -> Ordering
$ccompare :: ModName -> ModName -> Ordering
$cp1Ord :: Eq ModName
Ord,Int -> ModName -> ShowS
[ModName] -> ShowS
ModName -> String
(Int -> ModName -> ShowS)
-> (ModName -> String) -> ([ModName] -> ShowS) -> Show ModName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModName] -> ShowS
$cshowList :: [ModName] -> ShowS
show :: ModName -> String
$cshow :: ModName -> String
showsPrec :: Int -> ModName -> ShowS
$cshowsPrec :: Int -> ModName -> ShowS
Show,(forall x. ModName -> Rep ModName x)
-> (forall x. Rep ModName x -> ModName) -> Generic ModName
forall x. Rep ModName x -> ModName
forall x. ModName -> Rep ModName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModName x -> ModName
$cfrom :: forall x. ModName -> Rep ModName x
Generic)

instance NFData ModName

modNameToText :: ModName -> T.Text
modNameToText :: ModName -> Text
modNameToText (ModName x :: Text
x) = Text
x

textToModName :: T.Text -> ModName
textToModName :: Text -> ModName
textToModName = Text -> ModName
ModName

modNameChunks :: ModName -> [String]
modNameChunks :: ModName -> [String]
modNameChunks  = (Text -> Maybe (String, Text)) -> Text -> [String]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Text -> Maybe (String, Text)
step (Text -> [String]) -> (ModName -> Text) -> ModName -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModName -> Text
modNameToText (ModName -> Text) -> (ModName -> ModName) -> ModName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModName -> ModName
notParamInstModName
  where
  step :: Text -> Maybe (String, Text)
step str :: Text
str
    | Text -> Bool
T.null Text
str = Maybe (String, Text)
forall a. Maybe a
Nothing
    | Bool
otherwise  = case Text -> Text -> (Text, Text)
T.breakOn Text
modSep Text
str of
                     (a :: Text
a,b :: Text
b) -> (String, Text) -> Maybe (String, Text)
forall a. a -> Maybe a
Just (Text -> String
T.unpack Text
a,Int -> Text -> Text
T.drop (Text -> Int
T.length Text
modSep) Text
b)

isParamInstModName :: ModName -> Bool
isParamInstModName :: ModName -> Bool
isParamInstModName (ModName x :: Text
x) = Text
modInstPref Text -> Text -> Bool
`T.isPrefixOf` Text
x

-- | Convert a parameterized module's name to the name of the module
-- containing the same definitions but with explicit parameters on each
-- definition.
paramInstModName :: ModName -> ModName
paramInstModName :: ModName -> ModName
paramInstModName (ModName x :: Text
x)
  | Text
modInstPref Text -> Text -> Bool
`T.isPrefixOf` Text
x = Text -> ModName
ModName Text
x
  | Bool
otherwise = Text -> ModName
ModName (Text -> Text -> Text
T.append Text
modInstPref Text
x)


notParamInstModName :: ModName -> ModName
notParamInstModName :: ModName -> ModName
notParamInstModName (ModName x :: Text
x)
  | Text
modInstPref Text -> Text -> Bool
`T.isPrefixOf` Text
x = Text -> ModName
ModName (Int -> Text -> Text
T.drop (Text -> Int
T.length Text
modInstPref) Text
x)
  | Bool
otherwise = Text -> ModName
ModName Text
x


packModName :: [T.Text] -> ModName
packModName :: [Text] -> ModName
packModName strs :: [Text]
strs = Text -> ModName
textToModName (Text -> [Text] -> Text
T.intercalate Text
modSep ((Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
trim [Text]
strs))
  where
  -- trim space off of the start and end of the string
  trim :: Text -> Text
trim str :: Text
str = (Char -> Bool) -> Text -> Text
T.dropWhile Char -> Bool
isSpace ((Char -> Bool) -> Text -> Text
T.dropWhileEnd Char -> Bool
isSpace Text
str)

modSep :: T.Text
modSep :: Text
modSep  = "::"

modInstPref :: T.Text
modInstPref :: Text
modInstPref = "`"


preludeName :: ModName
preludeName :: ModName
preludeName  = [Text] -> ModName
packModName ["Cryptol"]

interactiveName :: ModName
interactiveName :: ModName
interactiveName  = [Text] -> ModName
packModName ["<interactive>"]

noModuleName :: ModName
noModuleName :: ModName
noModuleName = [Text] -> ModName
packModName ["<none>"]

exprModName :: ModName
exprModName :: ModName
exprModName = [Text] -> ModName
packModName ["<expr>"]


--------------------------------------------------------------------------------

-- | Identifiers, along with a flag that indicates whether or not they're infix
-- operators. The boolean is present just as cached information from the lexer,
-- and never used during comparisons.
data Ident = Ident Bool T.Text
             deriving (Int -> Ident -> ShowS
[Ident] -> ShowS
Ident -> String
(Int -> Ident -> ShowS)
-> (Ident -> String) -> ([Ident] -> ShowS) -> Show Ident
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ident] -> ShowS
$cshowList :: [Ident] -> ShowS
show :: Ident -> String
$cshow :: Ident -> String
showsPrec :: Int -> Ident -> ShowS
$cshowsPrec :: Int -> Ident -> ShowS
Show,(forall x. Ident -> Rep Ident x)
-> (forall x. Rep Ident x -> Ident) -> Generic Ident
forall x. Rep Ident x -> Ident
forall x. Ident -> Rep Ident x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ident x -> Ident
$cfrom :: forall x. Ident -> Rep Ident x
Generic)

instance Eq Ident where
  a :: Ident
a == :: Ident -> Ident -> Bool
== b :: Ident
b = Ident -> Ident -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Ident
a Ident
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
  a :: Ident
a /= :: Ident -> Ident -> Bool
/= b :: Ident
b = Ident -> Ident -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Ident
a Ident
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ

instance Ord Ident where
  compare :: Ident -> Ident -> Ordering
compare (Ident _ i1 :: Text
i1) (Ident _ i2 :: Text
i2) = Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Text
i1 Text
i2

instance IsString Ident where
  fromString :: String -> Ident
fromString str :: String
str = Text -> Ident
mkIdent (String -> Text
T.pack String
str)

instance NFData Ident

packIdent :: String -> Ident
packIdent :: String -> Ident
packIdent  = Text -> Ident
mkIdent (Text -> Ident) -> (String -> Text) -> String -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

packInfix :: String -> Ident
packInfix :: String -> Ident
packInfix  = Text -> Ident
mkInfix (Text -> Ident) -> (String -> Text) -> String -> Ident
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack

unpackIdent :: Ident -> String
unpackIdent :: Ident -> String
unpackIdent  = Text -> String
T.unpack (Text -> String) -> (Ident -> Text) -> Ident -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
identText

mkIdent :: T.Text -> Ident
mkIdent :: Text -> Ident
mkIdent  = Bool -> Text -> Ident
Ident Bool
False

mkInfix :: T.Text -> Ident
mkInfix :: Text -> Ident
mkInfix  = Bool -> Text -> Ident
Ident Bool
True

isInfixIdent :: Ident -> Bool
isInfixIdent :: Ident -> Bool
isInfixIdent (Ident b :: Bool
b _) = Bool
b

nullIdent :: Ident -> Bool
nullIdent :: Ident -> Bool
nullIdent (Ident _ t :: Text
t) = Text -> Bool
T.null Text
t

identText :: Ident -> T.Text
identText :: Ident -> Text
identText (Ident _ t :: Text
t) = Text
t

modParamIdent :: Ident -> Ident
modParamIdent :: Ident -> Ident
modParamIdent (Ident x :: Bool
x t :: Text
t) = Bool -> Text -> Ident
Ident Bool
x (Text -> Text -> Text
T.append (String -> Text
T.pack "module parameter ") Text
t)