module Proteome.Tags.Query where

import Control.Monad.Extra (mapMaybeM)
import qualified Data.Text as Text
import Exon (exon)
import Path (Abs, File, Path)
import Prelude hiding (tag)
import Ribosome (Rpc)
import Ribosome.Api (taglist)
import Ribosome.Menu (MenuItem (MenuItem))

import Proteome.Tags.Mappings (checkPath)
import qualified Proteome.Tags.State as State
import Proteome.Tags.State (
  RawTagSegments (RawTagSegments),
  Tag (Tag),
  TagLoc (TagLoc),
  TagSegments (TagSegments),
  tagLoc,
  )

truncAndPad :: Int -> Text -> Text
truncAndPad :: Int -> Text -> Text
truncAndPad Int
n Text
t =
  Text
trunced Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
extra
  where
    extra :: Text
extra =
      if Bool
tooLong then Text
"…" else Int -> Text -> Text
Text.replicate (Int
diff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text
" "
    tooLong :: Bool
tooLong =
      Int
diff Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0
    diff :: Int
diff =
      Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
trunced
    trunced :: Text
trunced =
      Int -> Text -> Text
Text.take Int
n Text
t

renderTag :: Tag -> Text
renderTag :: Tag -> Text
renderTag Tag {Text
$sel:path:Tag :: Tag -> Text
path :: Text
path, $sel:segments:Tag :: Tag -> TagSegments
segments = TagSegments {Maybe Text
Text
$sel:modulePath:TagSegments :: TagSegments -> Maybe Text
$sel:package:TagSegments :: TagSegments -> Maybe Text
$sel:name:TagSegments :: TagSegments -> Text
modulePath :: Maybe Text
package :: Maybe Text
name :: Text
..}} =
  [exon|#{maybe "" renderPackage package}#{fromMaybe path modulePath}|]
  where
    renderPackage :: Text -> Text
renderPackage Text
p =
      [exon|📦 #{truncAndPad 20 p} |]

createTag ::
  (RawTagSegments -> TagSegments) ->
  Text ->
  Text ->
  Int ->
  Maybe (MenuItem Tag)
createTag :: (RawTagSegments -> TagSegments)
-> Text -> Text -> Int -> Maybe (MenuItem Tag)
createTag RawTagSegments -> TagSegments
mkSegments Text
name Text
path Int
line = do
  let
    segments :: TagSegments
segments = RawTagSegments -> TagSegments
mkSegments (Text -> Text -> RawTagSegments
RawTagSegments Text
name Text
path)
    tag :: Tag
tag = Tag :: Text -> Int -> TagSegments -> Tag
Tag {Int
Text
TagSegments
$sel:line:Tag :: Int
segments :: TagSegments
line :: Int
path :: Text
$sel:segments:Tag :: TagSegments
$sel:path:Tag :: Text
..}
    rendered :: Text
rendered = Tag -> Text
renderTag Tag
tag
  MenuItem Tag -> Maybe (MenuItem Tag)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tag -> Text -> Text -> MenuItem Tag
forall a. a -> Text -> Text -> MenuItem a
MenuItem Tag
tag Text
"" [exon| 🟣 #{truncedName} #{rendered}|])
  where
    truncedName :: Text
truncedName =
      Int -> Text -> Text
truncAndPad Int
20 Text
name

parseTaglistTag ::
  (RawTagSegments -> TagSegments) ->
  TagLoc Text ->
  Maybe (MenuItem Tag)
parseTaglistTag :: (RawTagSegments -> TagSegments)
-> TagLoc Text -> Maybe (MenuItem Tag)
parseTaglistTag RawTagSegments -> TagSegments
mkSegments TagLoc Text
loc =
  (RawTagSegments -> TagSegments)
-> Text -> Text -> Int -> Maybe (MenuItem Tag)
createTag RawTagSegments -> TagSegments
mkSegments (TagLoc Text
loc TagLoc Text -> Getting Text (TagLoc Text) Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting Text (TagLoc Text) Text)
Getting Text (TagLoc Text) Text
#name) (TagLoc Text
loc TagLoc Text -> Getting Text (TagLoc Text) Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "path" (Getting Text (TagLoc Text) Text)
Getting Text (TagLoc Text) Text
#path) (TagLoc Text
loc TagLoc Text -> Getting Int (TagLoc Text) Int -> Int
forall s a. s -> Getting a s a -> a
^. IsLabel "line" (Getting Int (TagLoc Text) Int)
Getting Int (TagLoc Text) Int
#line)

tagLocs ::
  Member Rpc r =>
  Maybe Text ->
  Maybe (Path Abs File) ->
  Sem r [TagLoc Text]
tagLocs :: forall (r :: EffectRow).
Member Rpc r =>
Maybe Text -> Maybe (Path Abs File) -> Sem r [TagLoc Text]
tagLocs Maybe Text
rex Maybe (Path Abs File)
file = do
  [Tag]
result <- Maybe Text -> Maybe (Path Abs File) -> Sem r [Tag]
forall (r :: EffectRow).
Member Rpc r =>
Maybe Text -> Maybe (Path Abs File) -> Sem r [Tag]
taglist Maybe Text
rex Maybe (Path Abs File)
file
  pure ((Tag -> Maybe (TagLoc Text)) -> [Tag] -> [TagLoc Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Tag -> Maybe (TagLoc Text)
tagLoc [Tag]
result)

checkLocPath ::
  Members [Rpc, Embed IO] r =>
  TagLoc Text ->
  Sem r (Maybe (TagLoc (Path Abs File)))
checkLocPath :: forall (r :: EffectRow).
Members '[Rpc, Embed IO] r =>
TagLoc Text -> Sem r (Maybe (TagLoc (Path Abs File)))
checkLocPath TagLoc {Int
Text
$sel:line:TagLoc :: forall p. TagLoc p -> Int
$sel:path:TagLoc :: forall p. TagLoc p -> p
$sel:name:TagLoc :: forall p. TagLoc p -> Text
line :: Int
path :: Text
name :: Text
..} =
  Text -> Sem r (Maybe (Path Abs File))
forall (r :: EffectRow).
Members '[Rpc, Embed IO] r =>
Text -> Sem r (Maybe (Path Abs File))
checkPath Text
path Sem r (Maybe (Path Abs File))
-> (Maybe (Path Abs File) -> Maybe (TagLoc (Path Abs File)))
-> Sem r (Maybe (TagLoc (Path Abs File)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Path Abs File -> TagLoc (Path Abs File))
-> Maybe (Path Abs File) -> Maybe (TagLoc (Path Abs File))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \ Path Abs File
f -> TagLoc :: forall p. Text -> p -> Int -> TagLoc p
TagLoc {$sel:path:TagLoc :: Path Abs File
path = Path Abs File
f, Int
Text
$sel:line:TagLoc :: Int
$sel:name:TagLoc :: Text
line :: Int
name :: Text
..}

tagLocsPath ::
  Members [Rpc, Embed IO] r =>
  Maybe Text ->
  Maybe (Path Abs File) ->
  Sem r [TagLoc (Path Abs File)]
tagLocsPath :: forall (r :: EffectRow).
Members '[Rpc, Embed IO] r =>
Maybe Text
-> Maybe (Path Abs File) -> Sem r [TagLoc (Path Abs File)]
tagLocsPath Maybe Text
rex Maybe (Path Abs File)
file =
  (TagLoc Text -> Sem r (Maybe (TagLoc (Path Abs File))))
-> [TagLoc Text] -> Sem r [TagLoc (Path Abs File)]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM TagLoc Text -> Sem r (Maybe (TagLoc (Path Abs File)))
forall (r :: EffectRow).
Members '[Rpc, Embed IO] r =>
TagLoc Text -> Sem r (Maybe (TagLoc (Path Abs File)))
checkLocPath ([TagLoc Text] -> Sem r [TagLoc (Path Abs File)])
-> Sem r [TagLoc Text] -> Sem r [TagLoc (Path Abs File)]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text -> Maybe (Path Abs File) -> Sem r [TagLoc Text]
forall (r :: EffectRow).
Member Rpc r =>
Maybe Text -> Maybe (Path Abs File) -> Sem r [TagLoc Text]
tagLocs Maybe Text
rex Maybe (Path Abs File)
file

query ::
  Member Rpc r =>
  (RawTagSegments -> TagSegments) ->
  Text ->
  Sem r [MenuItem Tag]
query :: forall (r :: EffectRow).
Member Rpc r =>
(RawTagSegments -> TagSegments) -> Text -> Sem r [MenuItem Tag]
query RawTagSegments -> TagSegments
mkSegments Text
rex =
  (TagLoc Text -> Maybe (MenuItem Tag))
-> [TagLoc Text] -> [MenuItem Tag]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((RawTagSegments -> TagSegments)
-> TagLoc Text -> Maybe (MenuItem Tag)
parseTaglistTag RawTagSegments -> TagSegments
mkSegments) ([TagLoc Text] -> [MenuItem Tag])
-> Sem r [TagLoc Text] -> Sem r [MenuItem Tag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text -> Maybe (Path Abs File) -> Sem r [TagLoc Text]
forall (r :: EffectRow).
Member Rpc r =>
Maybe Text -> Maybe (Path Abs File) -> Sem r [TagLoc Text]
tagLocs (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
rex) Maybe (Path Abs File)
forall a. Maybe a
Nothing