giak (empty) → 0.1.0.0

raw patch · 5 files changed

+186/−0 lines, 5 filesdep +Cabaldep +asyncdep +basesetup-changed

Dependencies added: Cabal, async, base, bytestring, containers, directory, extra, filemanip, filepath, mtl, process, semigroups, stm, stm-chans, text, unix, wybor

Files

• LICENSE +19/−0
• Setup.hs +2/−0
• giak.cabal +37/−0
• src/IOCTL.chs +34/−0
• src/Main.hs +94/−0

@@ -0,0 +1,19 @@+Copyright (c) 2016 Nicolas Mattia++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,37 @@+name:                giak+version:             0.1.0.0+synopsis:            Fuzzy finder for cabal executables+description:         Please see README.md+homepage:            http://github.com/nmattia/giak+license:             MIT+license-file:        LICENSE+author:              Nicolas Mattia+maintainer:          nicolas@nmattia.com+copyright:           2016 Nicolas Mattia+category:            Web+build-type:          Simple+cabal-version:       >=1.10++executable giak+  hs-source-dirs:      src+  main-is:             Main.hs+  default-language:    Haskell2010+  build-depends:       base >= 4.7 && < 5+                     , Cabal    >= 1.18+                     , async    >= 2.0+                     , filepath >= 1.3+                     , extra    >= 1.0+                     , bytestring >= 0.10+                     , containers >= 0.5+                     , directory >= 1.2+                     , filemanip >= 0.3+                     , mtl >= 2.1+                     , process >= 1.2+                     , semigroups >= 0.16+                     , stm >= 2.4+                     , stm-chans >= 3.0+                     , text >= 1.2+                     , unix >= 2.7+                     , wybor >= 0.1+  ghc-options:        -Wall+  other-modules:       IOCTL

@@ -0,0 +1,34 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}++#include "sys/ioctl.h"++module IOCTL (+      writeOnTTY+    , runOnTTY+    ) where++import Data.Monoid ((<>))+import Data.ByteString (ByteString)+import Data.ByteString.Unsafe+import Foreign hiding (void)+import Foreign.C.Types+import Foreign.C.String++import qualified Data.ByteString as B++foreign import ccall "sys/ioctl.h ioctl"+    c_ioctl :: CInt -> CInt -> Ptr CChar -> IO ()++runOnTTY :: ByteString -> IO ()+runOnTTY bs = writeOnTTY (bs <> "\n")++writeOnTTY :: ByteString -> IO ()+writeOnTTY bs = unsafeUseAsCString bs (doTheThing l)+  where l = B.length bs++doTheThing :: Int -> CString -> IO ()+doTheThing l str = mapM_ writeByte [0 .. (l-1)]+  where writeByte i  = c_ioctl 0 code (plusPtr str i)+        code = {#const TIOCSTI#}

@@ -0,0 +1,94 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Concurrent.Async                      (async, cancel, wait)+import Control.Concurrent.STM.TMQueue                (TMQueue, newTMQueueIO,+                                                      tryReadTMQueue,+                                                      writeTMQueue)+import Control.Monad+import Control.Monad.Extra+import Control.Monad.STM                             (atomically)+import Data.List.NonEmpty                            (NonEmpty (..))+import Data.Maybe                                    (isJust)+import Data.Monoid                                   ((<>))+import Distribution.PackageDescription.Configuration (flattenPackageDescription)+import Distribution.PackageDescription.Parse         (readPackageDescription)+import IOCTL                                         (writeOnTTY)+import System.Directory                              (doesFileExist,+                                                      findExecutable)+import System.FilePath.Glob                          (namesMatching)++import qualified Data.Text                       as T+import qualified Data.Text.Encoding              as T+import qualified Distribution.PackageDescription as Cabal+import qualified Distribution.Verbosity          as Verbosity+import qualified Wybor++data GiakResult = GiakResult BuildTool Cabal.Executable++data BuildTool = Cabal | Stack++type GatherChan = TMQueue (NonEmpty (T.Text, T.Text))++buildCommand :: GiakResult -> T.Text+buildCommand = T.pack . unwords . buildCommand'+  where+    buildCommand' (GiakResult Stack exe) = ["stack", "exec", Cabal.exeName exe]+    buildCommand' (GiakResult Cabal exe) = ["cabal", "exec", Cabal.exeName exe]++main :: IO ()+main = do+    results <- newTMQueueIO+    gatherer <- async $ gatherExecutables results+    async (displayChoices results) >>= wait+    cancel gatherer++gatherExecutables :: GatherChan -> IO ()+gatherExecutables chan =+    loadResults >>= mapM_ (\res -> do+        let res' = (toDisplayedText res, buildCommand res)+        atomically $ writeTMQueue chan $  res' :| [])++toDisplayedText :: GiakResult -> T.Text+toDisplayedText res@(GiakResult _ exe) = name <> "   > " <> command+  where command = buildCommand res+        name = T.pack $ Cabal.exeName exe++displayChoices :: GatherChan -> IO ()+displayChoices results = do+    c <- Wybor.select . Wybor.fromIO . atomically $ tryReadTMQueue results+    case c of+        Right (Just c') -> writeOnTTY $ T.encodeUtf8 c'+        _ -> return ()++loadResults :: IO [GiakResult]+loadResults = do+    ss <- checkCabal+    ifM isStackReady+        (return $ toStackExe <$> ss)+        $ return ss+  where+    toStackExe (GiakResult _ exe) = GiakResult Stack exe++isStackReady :: IO Bool+isStackReady = isStackInstalled &&^ hasStackYaml+  where+    isStackInstalled = isJust <$> findExecutable "stack"+    hasStackYaml = doesFileExist "stack.yaml"++checkCabal :: IO [GiakResult]+checkCabal = namesMatching "*.cabal" >>= fromCabalFiles++fromCabalFiles :: [FilePath] -> IO [GiakResult]+fromCabalFiles fs = do+    ress <- forM fs $ \f -> (mkResult <$>) <$> readExecutables f+    return $ concat ress++readExecutables :: FilePath -> IO [Cabal.Executable]+readExecutables f =+  Cabal.executables . flattenPackageDescription <$>+    readPackageDescription Verbosity.silent f++mkResult :: Cabal.Executable -> GiakResult+mkResult = GiakResult Cabal