module Imp.Type.Alias where

import qualified Control.Monad as Monad
import qualified Control.Monad.Catch as Exception
import qualified Data.Map as Map
import qualified GHC.Plugins as Plugin
import qualified Imp.Exception.InvalidAlias as InvalidAlias
import qualified Imp.Extra.ModuleName as ModuleName

data Alias = Alias
  { Alias -> ModuleName
source :: Plugin.ModuleName,
    Alias -> ModuleName
target :: Plugin.ModuleName
  }
  deriving (Alias -> Alias -> Bool
(Alias -> Alias -> Bool) -> (Alias -> Alias -> Bool) -> Eq Alias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Alias -> Alias -> Bool
== :: Alias -> Alias -> Bool
$c/= :: Alias -> Alias -> Bool
/= :: Alias -> Alias -> Bool
Eq, Int -> Alias -> ShowS
[Alias] -> ShowS
Alias -> String
(Int -> Alias -> ShowS)
-> (Alias -> String) -> ([Alias] -> ShowS) -> Show Alias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Alias -> ShowS
showsPrec :: Int -> Alias -> ShowS
$cshow :: Alias -> String
show :: Alias -> String
$cshowList :: [Alias] -> ShowS
showList :: [Alias] -> ShowS
Show)

fromString :: (Exception.MonadThrow m) => String -> m Alias
fromString :: forall (m :: * -> *). MonadThrow m => String -> m Alias
fromString String
string = do
  let (String
before, String
after) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') String
string
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Monad.when (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
after) (m () -> m ()) -> (InvalidAlias -> m ()) -> InvalidAlias -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InvalidAlias -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
Exception.throwM (InvalidAlias -> m ()) -> InvalidAlias -> m ()
forall a b. (a -> b) -> a -> b
$ String -> InvalidAlias
InvalidAlias.new String
string
  ModuleName
src <- String -> m ModuleName
forall (m :: * -> *). MonadThrow m => String -> m ModuleName
ModuleName.fromString String
before
  ModuleName
tgt <- String -> m ModuleName
forall (m :: * -> *). MonadThrow m => String -> m ModuleName
ModuleName.fromString (String -> m ModuleName) -> ShowS -> String -> m ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 (String -> m ModuleName) -> String -> m ModuleName
forall a b. (a -> b) -> a -> b
$ String
after
  Alias -> m Alias
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Alias {source :: ModuleName
source = ModuleName
src, target :: ModuleName
target = ModuleName
tgt}

toMap :: [Alias] -> Map.Map Plugin.ModuleName Plugin.ModuleName
toMap :: [Alias] -> Map ModuleName ModuleName
toMap = (ModuleName -> ModuleName -> ModuleName)
-> [(ModuleName, ModuleName)] -> Map ModuleName ModuleName
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ((ModuleName -> ModuleName)
-> ModuleName -> ModuleName -> ModuleName
forall a b. a -> b -> a
const ModuleName -> ModuleName
forall a. a -> a
id) ([(ModuleName, ModuleName)] -> Map ModuleName ModuleName)
-> ([Alias] -> [(ModuleName, ModuleName)])
-> [Alias]
-> Map ModuleName ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alias -> (ModuleName, ModuleName))
-> [Alias] -> [(ModuleName, ModuleName)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Alias
x -> (Alias -> ModuleName
target Alias
x, Alias -> ModuleName
source Alias
x))