Experiments with Shelly

HelloShelly.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Applicative
import Control.Lens

import Control.Monad.Trans (MonadIO(..))

import Data.Monoid (First)

import Data.ByteString.Lazy (fromChunks)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8)
import Data.Aeson.TH (deriveJSON, defaultOptions, Options(..))
import Data.Aeson (Value(..), FromJSON(..), decode, eitherDecode)
import Data.Char (toLower)
import Control.Lens.Aeson (key, nth, _Number, _Value)
import Shelly (Sh)
import qualified Shelly as Sh


--------------------------------------------------------------------------------

instance FromJSON a => Sh.ShellCmd (Sh (Maybe a)) where
  cmdAll filepath args = do
   result <- Sh.cmdAll filepath args
   return $ decode $ fromChunks $ return $ encodeUtf8 result

instance FromJSON a => Sh.ShellCmd (Sh (Either String a)) where
  cmdAll filepath args = do
   result <- Sh.cmdAll filepath args
   return $ eitherDecode $ fromChunks $ return $ encodeUtf8 result

--------------------------------------------------------------------------------

jq :: ((a -> Accessor (First a) a) -> Value -> Accessor (First a) Value)
   -> Text
   -> Maybe a
jq accessor txt =
  let lbs = fromChunks $ return $ encodeUtf8 txt
  in lbs ^? _Value . accessor

--------------------------------------------------------------------------------

-- main :: IO ()
-- main = Sh.shelly $ Sh.verbosely $ do
--   a <- jq (key "pair" . nth 0 . _Number)
--          <$> Sh.cmd "echo" ("{\"pair\": [1, 2]}" :: Text)
--   liftIO $ print a


--------------------------------------------------------------------------------

data Person
  = Person {
    _personName :: String
  , _personAge  :: Int
  }
  deriving (Show)

$(deriveJSON (defaultOptions { fieldLabelModifier = map toLower . drop 7 })
             ''Person)

main :: IO ()
main = Sh.shelly $ do
  result <- Sh.cmd "echo" ("{\"name\": \"Roman\", \"age\": 28 }" :: Text)
  case result of
    Left err -> liftIO $ print (err :: String)
    Right person -> liftIO $ putStrLn (_personName person)