{-# LANGUAGE FunctionalDependencies, LambdaCase #-} module Semantic.Api.Bridge ( APIBridge (..) , APIConvert (..) , (#?) ) where import Control.Lens import qualified Data.Blob as Data import qualified Data.Language as Data import Data.Source (fromText, toText) import qualified Data.Span as Data import qualified Data.Text as T import qualified Semantic.Api.LegacyTypes as Legacy import qualified Semantic.Api.V1.CodeAnalysisPB as API -- | An @APIBridge x y@ instance describes an isomorphism between @x@ and @y@. -- This is suitable for types such as 'Pos' which are representationally equivalent -- in their API, legacy, and native forms. All 'Lens' laws apply. -- -- Foreign to native: @x^.bridging@ -- Native to foreign: @bridging # x@ -- Native to 'Just' foreign: @bridging #? x@. -- 'Maybe' foreign to 'Maybe' native: @x >>= preview bridging@ class APIBridge api native | api -> native where bridging :: Iso' api native -- | An @APIConvert x y@ instance describes a partial isomorphism between @x@ and @y@. -- This is suitable for types containing nested records therein, such as 'Span'. -- (The isomorphism must be partial, given that a protobuf record can have Nothing -- for all its fields, which means we cannot convert to a native format.) -- -- Foreign to native: this is a type error, unless the native is a Monoid -- Foreign to 'Maybe' native: @x^?converting@ -- Native to foreign: @converting # x@ -- Native to 'Just' foreign: @converting #? x@ class APIConvert api native | api -> native where converting :: Prism' api native -- | A helper function for turning 'bridging' around and -- extracting 'Just' values from it. (#?) :: AReview t s -> s -> Maybe t rev #? item = item ^? re rev infixr 8 #? instance APIBridge Legacy.Position Data.Pos where bridging = iso fromAPI toAPI where toAPI Data.Pos{..} = Legacy.Position posLine posColumn fromAPI Legacy.Position{..} = Data.Pos line column instance APIBridge API.Position Data.Pos where bridging = iso fromAPI toAPI where toAPI Data.Pos{..} = API.Position (fromIntegral posLine) (fromIntegral posColumn) fromAPI API.Position{..} = Data.Pos (fromIntegral line) (fromIntegral column) instance APIConvert API.Span Data.Span where converting = prism' toAPI fromAPI where toAPI Data.Span{..} = API.Span (bridging #? spanStart) (bridging #? spanEnd) fromAPI API.Span{..} = Data.Span <$> (start >>= preview bridging) <*> (end >>= preview bridging) instance APIConvert Legacy.Span Data.Span where converting = prism' toAPI fromAPI where toAPI Data.Span{..} = Legacy.Span (bridging #? spanStart) (bridging #? spanEnd) fromAPI Legacy.Span {..} = Data.Span <$> (start >>= preview bridging) <*> (end >>= preview bridging) instance APIBridge T.Text Data.Language where bridging = iso apiLanguageToLanguage languageToApiLanguage where languageToApiLanguage :: Data.Language -> T.Text languageToApiLanguage = \case Data.Unknown -> "Unknown" Data.Go -> "Go" Data.Haskell -> "Haskell" Data.Java -> "Java" Data.JavaScript -> "JavaScript" Data.JSON -> "JSON" Data.JSX -> "JSX" Data.Markdown -> "Markdown" Data.Python -> "Python" Data.Ruby -> "Ruby" Data.TypeScript -> "TypeScript" Data.TSX -> "TSX" Data.PHP -> "PHP" apiLanguageToLanguage :: T.Text -> Data.Language apiLanguageToLanguage = \case "Go" -> Data.Go "Haskell" -> Data.Haskell "Java" -> Data.Java "JavaScript" -> Data.JavaScript "JSON" -> Data.JSON "JSX" -> Data.JSX "Markdown" -> Data.Markdown "Python" -> Data.Python "Ruby" -> Data.Ruby "TypeScript" -> Data.TypeScript "TSX" -> Data.TSX "PHP" -> Data.PHP _ -> Data.Unknown instance APIBridge API.Blob Data.Blob where bridging = iso apiBlobToBlob blobToApiBlob where blobToApiBlob b = API.Blob (toText (Data.blobSource b)) (T.pack (Data.blobPath b)) (bridging # Data.blobLanguage b) apiBlobToBlob API.Blob{..} = Data.makeBlob (fromText content) (T.unpack path) (language ^. bridging) mempty instance APIConvert API.BlobPair Data.BlobPair where converting = prism' blobPairToApiBlobPair apiBlobPairToBlobPair where apiBlobPairToBlobPair (API.BlobPair (Just before) (Just after)) = Just $ Data.Diffing (before^.bridging) (after^.bridging) apiBlobPairToBlobPair (API.BlobPair (Just before) Nothing) = Just $ Data.Deleting (before^.bridging) apiBlobPairToBlobPair (API.BlobPair Nothing (Just after)) = Just $ Data.Inserting (after^.bridging) apiBlobPairToBlobPair _ = Nothing blobPairToApiBlobPair (Data.Diffing before after) = API.BlobPair (bridging #? before) (bridging #? after) blobPairToApiBlobPair (Data.Inserting after) = API.BlobPair Nothing (bridging #? after) blobPairToApiBlobPair (Data.Deleting before) = API.BlobPair (bridging #? before) Nothing