module Proteome.Tags.State where

import Control.Lens.Regex.Text (Match, group, regex)
import Data.Char (isUpper)
import Data.List.Extra (takeWhileEnd)
import qualified Data.Text as Text
import Exon (exon)
import Lens.Micro.Extras (preview, view)
import Prelude hiding (group)
import qualified Ribosome
import Ribosome.Menu (Filter, MenuItem, Modal)
import qualified Ribosome.Menu.MenuState as MenuState
import Ribosome.Menu.MenuState (FilterMode (FilterMode), MenuMode (cycleFilter, filterMode, renderExtra, renderFilter))

import Proteome.Data.ProjectType (ProjectType (ProjectType))

data TagLoc p =
  TagLoc {
    forall p. TagLoc p -> Text
name :: Text,
    forall p. TagLoc p -> p
path :: p,
    forall p. TagLoc p -> Int
line :: Int
  }
  deriving stock (TagLoc p -> TagLoc p -> Bool
(TagLoc p -> TagLoc p -> Bool)
-> (TagLoc p -> TagLoc p -> Bool) -> Eq (TagLoc p)
forall p. Eq p => TagLoc p -> TagLoc p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagLoc p -> TagLoc p -> Bool
$c/= :: forall p. Eq p => TagLoc p -> TagLoc p -> Bool
== :: TagLoc p -> TagLoc p -> Bool
$c== :: forall p. Eq p => TagLoc p -> TagLoc p -> Bool
Eq, Int -> TagLoc p -> ShowS
[TagLoc p] -> ShowS
TagLoc p -> String
(Int -> TagLoc p -> ShowS)
-> (TagLoc p -> String) -> ([TagLoc p] -> ShowS) -> Show (TagLoc p)
forall p. Show p => Int -> TagLoc p -> ShowS
forall p. Show p => [TagLoc p] -> ShowS
forall p. Show p => TagLoc p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagLoc p] -> ShowS
$cshowList :: forall p. Show p => [TagLoc p] -> ShowS
show :: TagLoc p -> String
$cshow :: forall p. Show p => TagLoc p -> String
showsPrec :: Int -> TagLoc p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> TagLoc p -> ShowS
Show, (forall x. TagLoc p -> Rep (TagLoc p) x)
-> (forall x. Rep (TagLoc p) x -> TagLoc p) -> Generic (TagLoc p)
forall x. Rep (TagLoc p) x -> TagLoc p
forall x. TagLoc p -> Rep (TagLoc p) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p x. Rep (TagLoc p) x -> TagLoc p
forall p x. TagLoc p -> Rep (TagLoc p) x
$cto :: forall p x. Rep (TagLoc p) x -> TagLoc p
$cfrom :: forall p x. TagLoc p -> Rep (TagLoc p) x
Generic)

tagLoc :: Ribosome.Tag -> Maybe (TagLoc Text)
tagLoc :: Tag -> Maybe (TagLoc Text)
tagLoc Tag
t = do
  Int
line <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
forall a. ToString a => a -> String
toString (Tag
t Tag -> Getting Text Tag Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "cmd" (Getting Text Tag Text)
Getting Text Tag Text
#cmd))
  pure TagLoc :: forall p. Text -> p -> Int -> TagLoc p
TagLoc {$sel:name:TagLoc :: Text
name = Tag
t Tag -> Getting Text Tag Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "name" (Getting Text Tag Text)
Getting Text Tag Text
#name, $sel:path:TagLoc :: Text
path = Tag
t Tag -> Getting Text Tag Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "filename" (Getting Text Tag Text)
Getting Text Tag Text
#filename, $sel:line:TagLoc :: Int
line = Int
line Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1}

data RawTagSegments =
  RawTagSegments {
    RawTagSegments -> Text
name :: Text,
    RawTagSegments -> Text
path :: Text
  }
  deriving stock (RawTagSegments -> RawTagSegments -> Bool
(RawTagSegments -> RawTagSegments -> Bool)
-> (RawTagSegments -> RawTagSegments -> Bool) -> Eq RawTagSegments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawTagSegments -> RawTagSegments -> Bool
$c/= :: RawTagSegments -> RawTagSegments -> Bool
== :: RawTagSegments -> RawTagSegments -> Bool
$c== :: RawTagSegments -> RawTagSegments -> Bool
Eq, Int -> RawTagSegments -> ShowS
[RawTagSegments] -> ShowS
RawTagSegments -> String
(Int -> RawTagSegments -> ShowS)
-> (RawTagSegments -> String)
-> ([RawTagSegments] -> ShowS)
-> Show RawTagSegments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawTagSegments] -> ShowS
$cshowList :: [RawTagSegments] -> ShowS
show :: RawTagSegments -> String
$cshow :: RawTagSegments -> String
showsPrec :: Int -> RawTagSegments -> ShowS
$cshowsPrec :: Int -> RawTagSegments -> ShowS
Show, (forall x. RawTagSegments -> Rep RawTagSegments x)
-> (forall x. Rep RawTagSegments x -> RawTagSegments)
-> Generic RawTagSegments
forall x. Rep RawTagSegments x -> RawTagSegments
forall x. RawTagSegments -> Rep RawTagSegments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RawTagSegments x -> RawTagSegments
$cfrom :: forall x. RawTagSegments -> Rep RawTagSegments x
Generic)

data TagSegments =
  TagSegments {
    TagSegments -> Text
name :: Text,
    TagSegments -> Maybe Text
package :: Maybe Text,
    TagSegments -> Maybe Text
modulePath :: Maybe Text
  }
  deriving stock (TagSegments -> TagSegments -> Bool
(TagSegments -> TagSegments -> Bool)
-> (TagSegments -> TagSegments -> Bool) -> Eq TagSegments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagSegments -> TagSegments -> Bool
$c/= :: TagSegments -> TagSegments -> Bool
== :: TagSegments -> TagSegments -> Bool
$c== :: TagSegments -> TagSegments -> Bool
Eq, Int -> TagSegments -> ShowS
[TagSegments] -> ShowS
TagSegments -> String
(Int -> TagSegments -> ShowS)
-> (TagSegments -> String)
-> ([TagSegments] -> ShowS)
-> Show TagSegments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagSegments] -> ShowS
$cshowList :: [TagSegments] -> ShowS
show :: TagSegments -> String
$cshow :: TagSegments -> String
showsPrec :: Int -> TagSegments -> ShowS
$cshowsPrec :: Int -> TagSegments -> ShowS
Show, (forall x. TagSegments -> Rep TagSegments x)
-> (forall x. Rep TagSegments x -> TagSegments)
-> Generic TagSegments
forall x. Rep TagSegments x -> TagSegments
forall x. TagSegments -> Rep TagSegments x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagSegments x -> TagSegments
$cfrom :: forall x. TagSegments -> Rep TagSegments x
Generic)

data Tag =
  Tag {
    Tag -> Text
path :: Text,
    Tag -> Int
line :: Int,
    Tag -> TagSegments
segments :: TagSegments
  }
  deriving stock (Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c== :: Tag -> Tag -> Bool
Eq, Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag] -> ShowS
$cshowList :: [Tag] -> ShowS
show :: Tag -> String
$cshow :: Tag -> String
showsPrec :: Int -> Tag -> ShowS
$cshowsPrec :: Int -> Tag -> ShowS
Show, (forall x. Tag -> Rep Tag x)
-> (forall x. Rep Tag x -> Tag) -> Generic Tag
forall x. Rep Tag x -> Tag
forall x. Tag -> Rep Tag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tag x -> Tag
$cfrom :: forall x. Tag -> Rep Tag x
Generic)

data Segment =
  Name
  |
  Package
  |
  Module
  deriving stock (Segment -> Segment -> Bool
(Segment -> Segment -> Bool)
-> (Segment -> Segment -> Bool) -> Eq Segment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Segment -> Segment -> Bool
$c/= :: Segment -> Segment -> Bool
== :: Segment -> Segment -> Bool
$c== :: Segment -> Segment -> Bool
Eq, Int -> Segment -> ShowS
[Segment] -> ShowS
Segment -> String
(Int -> Segment -> ShowS)
-> (Segment -> String) -> ([Segment] -> ShowS) -> Show Segment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Segment] -> ShowS
$cshowList :: [Segment] -> ShowS
show :: Segment -> String
$cshow :: Segment -> String
showsPrec :: Int -> Segment -> ShowS
$cshowsPrec :: Int -> Segment -> ShowS
Show, Eq Segment
Eq Segment
-> (Segment -> Segment -> Ordering)
-> (Segment -> Segment -> Bool)
-> (Segment -> Segment -> Bool)
-> (Segment -> Segment -> Bool)
-> (Segment -> Segment -> Bool)
-> (Segment -> Segment -> Segment)
-> (Segment -> Segment -> Segment)
-> Ord Segment
Segment -> Segment -> Bool
Segment -> Segment -> Ordering
Segment -> Segment -> Segment
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 :: Segment -> Segment -> Segment
$cmin :: Segment -> Segment -> Segment
max :: Segment -> Segment -> Segment
$cmax :: Segment -> Segment -> Segment
>= :: Segment -> Segment -> Bool
$c>= :: Segment -> Segment -> Bool
> :: Segment -> Segment -> Bool
$c> :: Segment -> Segment -> Bool
<= :: Segment -> Segment -> Bool
$c<= :: Segment -> Segment -> Bool
< :: Segment -> Segment -> Bool
$c< :: Segment -> Segment -> Bool
compare :: Segment -> Segment -> Ordering
$ccompare :: Segment -> Segment -> Ordering
Ord)

genericSegments :: RawTagSegments -> TagSegments
genericSegments :: RawTagSegments -> TagSegments
genericSegments RawTagSegments {Text
path :: Text
name :: Text
$sel:path:RawTagSegments :: RawTagSegments -> Text
$sel:name:RawTagSegments :: RawTagSegments -> Text
..} =
  TagSegments :: Text -> Maybe Text -> Maybe Text -> TagSegments
TagSegments {$sel:package:TagSegments :: Maybe Text
package = Maybe Text
forall a. Maybe a
Nothing, $sel:modulePath:TagSegments :: Maybe Text
modulePath = Maybe Text
forall a. Maybe a
Nothing, Text
name :: Text
$sel:name:TagSegments :: Text
..}

nixPackageRegex :: Traversal' Text Match
nixPackageRegex :: Traversal' Text Match
nixPackageRegex =
  [regex|/nix/store/[^-]+-([^/]+?)(-[\d.]+)?(-tags)?/|]

nixPackage :: Text -> Maybe Text
nixPackage :: Text -> Maybe Text
nixPackage =
  Getting (First Text) Text Text -> Text -> Maybe Text
forall a s. Getting (First a) s a -> s -> Maybe a
preview ((Match -> Const (First Text) Match)
-> Text -> Const (First Text) Text
Traversal' Text Match
nixPackageRegex ((Match -> Const (First Text) Match)
 -> Text -> Const (First Text) Text)
-> ((Text -> Const (First Text) Text)
    -> Match -> Const (First Text) Match)
-> Getting (First Text) Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> IndexedTraversal' Text Match Text
group Int
0)

haskellModule :: Text -> Maybe Text
haskellModule :: Text -> Maybe Text
haskellModule =
  Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> (Text -> Text) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Int -> Text -> Text
Text.dropEnd Int
3 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Text -> [Text] -> Text
Text.intercalate Text
"." ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhileEnd Text -> Bool
firstUpper ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  (Char -> Bool) -> Text -> [Text]
Text.split (Char
'/' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==)
  where
    firstUpper :: Text -> Bool
firstUpper Text
seg =
      ((Char, Text) -> Bool) -> Maybe (Char, Text) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> Bool
isUpper (Char -> Bool) -> ((Char, Text) -> Char) -> (Char, Text) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, Text) -> Char
forall a b. (a, b) -> a
fst) (Text -> Maybe (Char, Text)
Text.uncons Text
seg)

haskellSegments :: RawTagSegments -> TagSegments
haskellSegments :: RawTagSegments -> TagSegments
haskellSegments RawTagSegments {Text
path :: Text
name :: Text
$sel:path:RawTagSegments :: RawTagSegments -> Text
$sel:name:RawTagSegments :: RawTagSegments -> Text
..} =
  TagSegments :: Text -> Maybe Text -> Maybe Text -> TagSegments
TagSegments {$sel:package:TagSegments :: Maybe Text
package = Text -> Maybe Text
nixPackage Text
path, $sel:modulePath:TagSegments :: Maybe Text
modulePath = Text -> Maybe Text
haskellModule Text
path, Text
name :: Text
$sel:name:TagSegments :: Text
..}

tagSegmentsForProject :: ProjectType -> RawTagSegments -> TagSegments
tagSegmentsForProject :: ProjectType -> RawTagSegments -> TagSegments
tagSegmentsForProject = \case
  ProjectType Text
"haskell" ->
    RawTagSegments -> TagSegments
haskellSegments
  ProjectType
_ ->
    RawTagSegments -> TagSegments
genericSegments

tagSegmentsForFile :: RawTagSegments -> TagSegments
tagSegmentsForFile :: RawTagSegments -> TagSegments
tagSegmentsForFile RawTagSegments
segs =
  case (Char -> Bool) -> Text -> Text
Text.takeWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.') (RawTagSegments
segs RawTagSegments -> Getting Text RawTagSegments Text -> Text
forall s a. s -> Getting a s a -> a
^. IsLabel "path" (Getting Text RawTagSegments Text)
Getting Text RawTagSegments Text
#path) of
    Text
"hs" ->
      RawTagSegments -> TagSegments
haskellSegments RawTagSegments
segs
    Text
_ ->
      RawTagSegments -> TagSegments
genericSegments RawTagSegments
segs

tagSegmentsFor :: Maybe ProjectType -> RawTagSegments -> TagSegments
tagSegmentsFor :: Maybe ProjectType -> RawTagSegments -> TagSegments
tagSegmentsFor =
  (RawTagSegments -> TagSegments)
-> (ProjectType -> RawTagSegments -> TagSegments)
-> Maybe ProjectType
-> RawTagSegments
-> TagSegments
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RawTagSegments -> TagSegments
tagSegmentsForFile ProjectType -> RawTagSegments -> TagSegments
tagSegmentsForProject

renderSegment :: Segment -> Text
renderSegment :: Segment -> Text
renderSegment = \case
  Segment
Name -> Text
"name"
  Segment
Package -> Text
"package"
  Segment
Module -> Text
"module"

segmentExtract :: MenuItem Tag -> Segment -> Maybe Text
segmentExtract :: MenuItem Tag -> Segment -> Maybe Text
segmentExtract (Getting Tag (MenuItem Tag) Tag -> MenuItem Tag -> Tag
forall a s. Getting a s a -> s -> a
view IsLabel "meta" (Getting Tag (MenuItem Tag) Tag)
Getting Tag (MenuItem Tag) Tag
#meta -> Tag {$sel:segments:Tag :: Tag -> TagSegments
segments = TagSegments {Maybe Text
Text
modulePath :: Maybe Text
package :: Maybe Text
name :: Text
$sel:modulePath:TagSegments :: TagSegments -> Maybe Text
$sel:package:TagSegments :: TagSegments -> Maybe Text
$sel:name:TagSegments :: TagSegments -> Text
..}}) = \case
  Segment
Name -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
  Segment
Package -> Maybe Text
package
  Segment
Module -> Maybe Text
modulePath

cycle :: Segment -> Segment
cycle :: Segment -> Segment
cycle = \case
  Segment
Name -> Segment
Package
  Segment
Package -> Segment
Module
  Segment
Module -> Segment
Name

data TagsMode =
  TagsMode {
    TagsMode -> Filter
mode :: Filter,
    TagsMode -> Segment
segment :: Segment
  }
  deriving stock (TagsMode -> TagsMode -> Bool
(TagsMode -> TagsMode -> Bool)
-> (TagsMode -> TagsMode -> Bool) -> Eq TagsMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagsMode -> TagsMode -> Bool
$c/= :: TagsMode -> TagsMode -> Bool
== :: TagsMode -> TagsMode -> Bool
$c== :: TagsMode -> TagsMode -> Bool
Eq, Int -> TagsMode -> ShowS
[TagsMode] -> ShowS
TagsMode -> String
(Int -> TagsMode -> ShowS)
-> (TagsMode -> String) -> ([TagsMode] -> ShowS) -> Show TagsMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TagsMode] -> ShowS
$cshowList :: [TagsMode] -> ShowS
show :: TagsMode -> String
$cshow :: TagsMode -> String
showsPrec :: Int -> TagsMode -> ShowS
$cshowsPrec :: Int -> TagsMode -> ShowS
Show, Eq TagsMode
Eq TagsMode
-> (TagsMode -> TagsMode -> Ordering)
-> (TagsMode -> TagsMode -> Bool)
-> (TagsMode -> TagsMode -> Bool)
-> (TagsMode -> TagsMode -> Bool)
-> (TagsMode -> TagsMode -> Bool)
-> (TagsMode -> TagsMode -> TagsMode)
-> (TagsMode -> TagsMode -> TagsMode)
-> Ord TagsMode
TagsMode -> TagsMode -> Bool
TagsMode -> TagsMode -> Ordering
TagsMode -> TagsMode -> TagsMode
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 :: TagsMode -> TagsMode -> TagsMode
$cmin :: TagsMode -> TagsMode -> TagsMode
max :: TagsMode -> TagsMode -> TagsMode
$cmax :: TagsMode -> TagsMode -> TagsMode
>= :: TagsMode -> TagsMode -> Bool
$c>= :: TagsMode -> TagsMode -> Bool
> :: TagsMode -> TagsMode -> Bool
$c> :: TagsMode -> TagsMode -> Bool
<= :: TagsMode -> TagsMode -> Bool
$c<= :: TagsMode -> TagsMode -> Bool
< :: TagsMode -> TagsMode -> Bool
$c< :: TagsMode -> TagsMode -> Bool
compare :: TagsMode -> TagsMode -> Ordering
$ccompare :: TagsMode -> TagsMode -> Ordering
Ord, (forall x. TagsMode -> Rep TagsMode x)
-> (forall x. Rep TagsMode x -> TagsMode) -> Generic TagsMode
forall x. Rep TagsMode x -> TagsMode
forall x. TagsMode -> Rep TagsMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TagsMode x -> TagsMode
$cfrom :: forall x. TagsMode -> Rep TagsMode x
Generic)

type TagsState =
  Modal TagsMode Tag

instance MenuMode Tag TagsMode where
  type Filter TagsMode =
    FilterMode Filter

  cycleFilter :: TagsMode -> TagsMode
cycleFilter (TagsMode Filter
mode Segment
segment) =
    Filter -> Segment -> TagsMode
TagsMode (Filter -> Filter
forall i mode. MenuMode i mode => mode -> mode
cycleFilter Filter
mode) Segment
segment

  renderFilter :: TagsMode -> Text
renderFilter (TagsMode Filter
mode Segment
_) =
    Filter -> Text
forall i mode. MenuMode i mode => mode -> Text
renderFilter Filter
mode

  renderExtra :: TagsMode -> Maybe Text
renderExtra (TagsMode Filter
_ Segment
segment) =
    Text -> Maybe Text
forall a. a -> Maybe a
Just [exon|🔧 #{renderSegment segment}|]

  filterMode :: TagsMode -> Filter TagsMode Tag
filterMode (TagsMode Filter
mode Segment
segment) =
    Filter -> (MenuItem Tag -> Maybe Text) -> FilterMode Filter Tag
forall f i. f -> (MenuItem i -> Maybe Text) -> FilterMode f i
FilterMode Filter
mode ((MenuItem Tag -> Segment -> Maybe Text)
-> Segment -> MenuItem Tag -> Maybe Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip MenuItem Tag -> Segment -> Maybe Text
segmentExtract Segment
segment)