diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Andre Van Der Merwe (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,26 @@ +# Hoogle terminal GUI. + +**bhoogle** is a simple terminal GUI wrapper over [hoogle](https://hackage.haskell.org/package/hoogle). + + +![ui](http://www.andrevdm.com/images/bhoogle.png) + + +## Setup + - Make sure you have a local hoogle database created + - If you don't already, then + 1. Install hoogle (e.g. ```stack install hoogle``` or ```cabal install hoogle```) + 1. Generate the default database (```hoogle generate```) + +## Usage + 1. Enter a search in the "type" edit box + 1. Press enter to search: focus goes directly to the results list + 1. Or press tab to search and focus will go to the "text" edit box + 1. You can then filter the results by typing in the "text" edit box, any result containing the sub-string typed will be shown + 1. Navigate the results by using arrow or vi (hjkl) keys + 1. Pressing **'s'** in the results list will toggle the sort order + 1. Escape to exit + 1. Search-ahead is enable for any type search longer than ~3 characters + + +Note that the version described in the [blog](http://www.andrevdm.com/posts/2018-01-15-bhoogle.html) is on the [blog](https://github.com/andrevdm/bhoogle/tree/blog) branch. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,349 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Main where + +import Protolude +import Control.Lens ((^.), (.~), (%~)) +import Control.Lens.TH (makeLenses) +import qualified Data.List as Lst +import qualified Data.Time as Tm +import qualified Data.Text as Txt +import qualified Data.Vector as Vec +import Brick ((<+>), (<=>)) +import qualified Brick as B +import qualified Brick.BChan as BCh +import qualified Brick.Focus as BF +import qualified Brick.AttrMap as BA +import qualified Brick.Widgets.List as BL +import qualified Brick.Widgets.Edit as BE +import qualified Brick.Widgets.Border as BB +import qualified Brick.Widgets.Border.Style as BBS +import Control.Concurrent (threadDelay, forkIO) +import qualified Graphics.Vty as V +import qualified Graphics.Vty.Input.Events as K +import qualified Hoogle as H + + + +-- | Events that can be sent +-- | Here there is just one event for updating the time +newtype Event = EventUpdateTime Tm.LocalTime + +-- | Names use to identify each of the controls +data Name = TypeSearch + | TextSearch + | ListResults + deriving (Show, Eq, Ord) + +-- | Sort order +data SortBy = SortNone + | SortAsc + | SortDec + deriving (Eq) + + +-- | State of the brick app. Contains the controls and any other required state +data BrickState = BrickState { _stEditType :: !(BE.Editor Text Name) -- ^ Editor for the type to search for + , _stEditText :: !(BE.Editor Text Name) -- ^ Editor for a text search in the results + , _stTime :: !Tm.LocalTime -- ^ The current time + , _stFocus :: !(BF.FocusRing Name) -- ^ Focus ring - a circular list of focusable controls + , _stResults :: [H.Target] -- ^ The last set of search results from hoohle + , _stResultsList :: !(BL.List Name H.Target) -- ^ List for the search results + , _stSortResults :: SortBy -- ^ Current sort order for the results + } + +makeLenses ''BrickState + + +-- | Defines how the brick application will work / handle events +app :: B.App BrickState Event Name +app = B.App { B.appDraw = drawUI + , B.appChooseCursor = B.showFirstCursor + , B.appHandleEvent = handleEvent + , B.appStartEvent = pure + , B.appAttrMap = const theMap + } + + +main :: IO () +main = do + chan <- BCh.newBChan 5 -- ^ create a bounded channel for events + + -- Send a tick event every 1 seconds with the current time + -- Brick will send this to our event handler which can then update the stTime field + void . forkIO $ forever $ do + t <- getTime + BCh.writeBChan chan $ EventUpdateTime t + threadDelay $ 1 * 1000000 + + -- Initial current time value + t <- getTime + + -- Construct the initial state values + let st = BrickState { _stEditType = BE.editor TypeSearch (Just 1) "" + , _stEditText = BE.editor TextSearch (Just 1) "" + , _stResultsList = BL.list ListResults Vec.empty 1 + , _stTime = t + , _stFocus = BF.focusRing [TypeSearch, TextSearch, ListResults] + , _stResults = [] + , _stSortResults = SortNone + } + + -- And run brick + void $ B.customMain (V.mkVty V.defaultConfig) (Just chan) app st + + where + -- | Get the local time + getTime = do + t <- Tm.getCurrentTime + tz <- Tm.getCurrentTimeZone + pure $ Tm.utcToLocalTime tz t + + +-- | Main even handler for brick events +handleEvent :: BrickState -> B.BrickEvent Name Event -> B.EventM Name (B.Next BrickState) +handleEvent st ev = + case ev of + -- Handle keyboard events + -- k is the key + -- ms are the modifier keys + (B.VtyEvent ve@(V.EvKey k ms)) -> + case (k, ms) of + -- Escape quits the app, no matter what control has focus + (K.KEsc, []) -> B.halt st + + _ -> + -- How to interpret the key press depends on which control is focused + case BF.focusGetCurrent $ st ^. stFocus of + Just TypeSearch -> + case k of + K.KChar '\t' -> do + -- Search, clear sort order, focus next + found <- doSearch st + B.continue . filterResults $ st & stFocus %~ BF.focusNext + & stResults .~ found + & stSortResults .~ SortNone + + K.KBackTab ->do + -- Search, clear sort order, focus prev + found <- doSearch st + B.continue . filterResults $ st & stFocus %~ BF.focusPrev + & stResults .~ found + & stSortResults .~ SortNone + + K.KEnter -> do + -- Search, clear sort order, focus on results + -- This makes it faster if you want to search and navigate results without tabing through the text search box + found <- doSearch st + B.continue . filterResults $ st & stResults .~ found + & stSortResults .~ SortNone + & stFocus %~ BF.focusNext & stFocus %~ BF.focusNext + -- TODO with brick >= 0.33, rather than 2x focus next: & stFocus %~ BF.focusSetCurrent ListResults + + _ -> do + -- Let the editor handle all other events + r <- BE.handleEditorEvent ve $ st ^. stEditType + next <- liftIO . searchAhead doSearch $ st & stEditType .~ r + B.continue next + + + Just TextSearch -> + case k of + K.KChar '\t' -> B.continue $ st & stFocus %~ BF.focusNext -- Focus next + K.KBackTab -> B.continue $ st & stFocus %~ BF.focusPrev -- Focus previous + _ -> do + -- Let the editor handle all other events + r <- BE.handleEditorEvent ve $ st ^. stEditText + B.continue . filterResults $ st & stEditText .~ r + + Just ListResults -> + case k of + K.KChar '\t' -> B.continue $ st & stFocus %~ BF.focusNext -- Focus next + K.KBackTab -> B.continue $ st & stFocus %~ BF.focusPrev -- Focus previous + K.KChar 's' -> + -- Toggle the search order between ascending and descending, use asc if sort order was 'none' + let sortDir = if (st ^. stSortResults) == SortAsc then SortDec else SortAsc in + let sorter = if sortDir == SortDec then (Lst.sortBy $ flip compareType) else (Lst.sortBy compareType) in + B.continue . filterResults $ st & stResults %~ sorter + & stSortResults .~ sortDir + + _ -> do + -- Let the list handle all other events + -- Using handleListEventVi which adds vi-style keybindings for navigation + -- and the standard handleListEvent as a fallback for all other events + r <- BL.handleListEventVi BL.handleListEvent ve $ st ^. stResultsList + B.continue $ st & stResultsList .~ r + + _ -> B.continue st + + (B.AppEvent (EventUpdateTime time)) -> + -- Update the time in the state + B.continue $ st & stTime .~ time + + _ -> B.continue st + + where + doSearch st' = + liftIO $ searchHoogle (Txt.strip . Txt.concat $ BE.getEditContents (st' ^. stEditType)) + + +-- | Search ahead for type strings longer than 3 chars. +searchAhead :: (BrickState -> IO [H.Target]) -> BrickState -> IO BrickState +searchAhead search st = + let searchText = Txt.strip . Txt.concat . BE.getEditContents $ st ^. stEditType in + + if Txt.length (Txt.filter (`notElem` [' ', '\t', '(', ')', '=']) searchText) > 3 + then do + -- Search + found <- search st + pure . filterResults $ st & stResults .~ found + & stSortResults .~ SortNone + else + -- Just clear + pure $ st & stResults .~ [] + & stResultsList %~ BL.listClear + + +-- | Filter the results from hoogle using the search text +filterResults :: BrickState -> BrickState +filterResults st = + let allResults = st ^. stResults in + let filterText = Txt.toLower . Txt.strip . Txt.concat . BE.getEditContents $ st ^. stEditText in + + let results = + if Txt.null filterText + then allResults + else filter (\t -> Txt.isInfixOf filterText . Txt.toLower $ formatResult t) allResults + in + st & stResultsList .~ BL.list ListResults (Vec.fromList results) 1 + + +-- | Draw the UI +drawUI :: BrickState -> [B.Widget Name] +drawUI st = + [B.padAll 1 contentBlock] + + where + contentBlock = + (B.withBorderStyle BBS.unicode $ BB.border searchBlock) + <=> + B.padTop (B.Pad 1) resultsBlock + + resultsBlock = + let total = show . length $ st ^. stResults in + let showing = show . length $ st ^. stResultsList ^. BL.listElementsL in + (B.withAttr "infoTitle" $ B.txt "Results: ") <+> B.txt (showing <> "/" <> total) + <=> + (B.padTop (B.Pad 1) $ + resultsContent <+> resultsDetail + ) + + resultsContent = + BL.renderList (\_ e -> B.txt $ formatResult e) False (st ^. stResultsList) + + resultsDetail = + B.padLeft (B.Pad 1) $ + B.hLimit 60 $ + vtitle "package:" + <=> + B.padLeft (B.Pad 2) (B.txt $ getSelectedDetail (\t -> maybe "" (Txt.pack . fst) (H.targetPackage t))) + <=> + vtitle "module:" + <=> + B.padLeft (B.Pad 2) (B.txt $ getSelectedDetail (\t -> maybe "" (Txt.pack . fst) (H.targetModule t))) + <=> + vtitle "docs:" + <=> + B.padLeft (B.Pad 2) (B.txtWrap . reflow $ getSelectedDetail (Txt.pack . clean . H.targetDocs)) + <=> + B.fill ' ' + + searchBlock = + ((htitle "Type: " <+> editor TypeSearch (st ^. stEditType)) <+> time (st ^. stTime)) + <=> + (htitle "Text: " <+> editor TextSearch (st ^. stEditText)) + + htitle t = + B.hLimit 20 $ + B.withAttr "infoTitle" $ + B.txt t + + vtitle t = + B.withAttr "infoTitle" $ + B.txt t + + editor n e = + B.vLimit 1 $ + BE.renderEditor (B.txt . Txt.unlines) (BF.focusGetCurrent (st ^. stFocus) == Just n) e + + time t = + B.padLeft (B.Pad 1) $ + B.hLimit 20 $ + B.withAttr "time" $ + B.str (Tm.formatTime Tm.defaultTimeLocale "%H-%M-%S" t) + + getSelectedDetail fn = + case BL.listSelectedElement $ st ^. stResultsList of + Nothing -> "" + Just (_, e) -> fn e + + +-- | Reformat the text so that it can be wrapped nicely +reflow :: Text -> Text +reflow = Txt.replace "\0" "\n\n" . Txt.replace "\n" "" . Txt.replace "\n\n" "\0" + + +theMap :: BA.AttrMap +theMap = BA.attrMap V.defAttr [ (BE.editAttr , V.black `B.on` V.cyan) + , (BE.editFocusedAttr , V.black `B.on` V.yellow) + , (BL.listAttr , V.white `B.on` V.blue) + , (BL.listSelectedAttr, V.blue `B.on` V.white) + , ("infoTitle" , B.fg V.cyan) + , ("time" , B.fg V.yellow) + ] + + +---------------------------------------------------------------------------------------------- +-- | Compare two hoogle results for sorting +compareType :: H.Target -> H.Target -> Ordering +compareType a b = + compare (formatResult a) (formatResult b) + + +-- | Search hoogle using the default hoogle database +searchHoogle :: Text -> IO [H.Target] +searchHoogle f = do + d <- H.defaultDatabaseLocation + H.withDatabase d (\x -> pure $ H.searchDatabase x (Txt.unpack f)) + + +-- | Format the hoogle results so they roughly match what the terminal app would show +formatResult :: H.Target -> Text +formatResult t = + let typ = clean $ H.targetItem t in + let m = (clean . fst) <$> H.targetModule t in + Txt.pack $ fromMaybe "" m <> " :: " <> typ + + +clean :: [Char] -> [Char] +clean = unescapeHTML . stripTags + + +-- | From hoogle source: https://hackage.haskell.org/package/hoogle-5.0.16/docs/src/General-Util.html +unescapeHTML :: [Char] -> [Char] +unescapeHTML ('&':xs) + | Just x <- Lst.stripPrefix "lt;" xs = '<' : unescapeHTML x + | Just x <- Lst.stripPrefix "gt;" xs = '>' : unescapeHTML x + | Just x <- Lst.stripPrefix "amp;" xs = '&' : unescapeHTML x + | Just x <- Lst.stripPrefix "quot;" xs = '\"' : unescapeHTML x +unescapeHTML (x:xs) = x : unescapeHTML xs +unescapeHTML [] = [] + + +-- | From hakyll source: https://hackage.haskell.org/package/hakyll-4.1.2.1/docs/src/Hakyll-Web-Html.html#stripTags +stripTags :: [Char] -> [Char] +stripTags [] = [] +stripTags ('<' : xs) = stripTags $ drop 1 $ dropWhile (/= '>') xs +stripTags (x : xs) = x : stripTags xs diff --git a/bhoogle.cabal b/bhoogle.cabal new file mode 100644 --- /dev/null +++ b/bhoogle.cabal @@ -0,0 +1,39 @@ +name: bhoogle +version: 0.1.1.1 +synopsis: Simple terminal GUI for local hoogle. +description: bhoogle is a terminal GUI layer over local hoogle. It provides search ahead and sub-string filtering in addition to the usual type-search. +homepage: https://github.com/githubuser/bhoogle#readme +license: BSD3 +license-file: LICENSE +author: Andre Van Der Merwe +maintainer: andre@andrevdm.com +copyright: 2018 Andre Van Der Merwe +category: Development, Terminal +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +executable bhoogle + hs-source-dirs: app + main-is: Main.hs + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates -Wimplicit-prelude + build-depends: base >=4.7 && <5 + , protolude + , text + , containers + , brick + , safe-exceptions + , filepath + , directory + , vty + , vector + , process + , lens + , bytestring + , time + , hoogle + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/githubuser/bhoogle