    {-# LANGUAGE TypeApplications #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE AllowAmbiguousTypes #-}
    {-# LANGUAGE OverloadedStrings #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      : System.Taffybar.Widget.Crypto
    -- Copyright   : (c) Ivan A. Malison
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Ivan A. Malison
    -- Stability   : unstable
    -- Portability : unportable
    --
    -- This module provides widgets for tracking the price of crypto currency
    -- assets.
    -----------------------------------------------------------------------------
    module System.Taffybar.Widget.Crypto where

    import           Control.Concurrent
    import           Control.Monad
    import           Control.Monad.IO.Class
    import           Control.Monad.Trans.Class
    import           Control.Monad.Trans.Maybe
    import           Control.Monad.Trans.Reader
    import           Data.Aeson
    import           Data.Aeson.Types
    import qualified Data.Aeson.Key as Key
    import qualified Data.ByteString.Lazy as LBS
    import           Data.List.Split
    import           Data.Maybe
    import           Data.Proxy
    import qualified Data.Text
    import           GHC.TypeLits
    import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk
    import qualified GI.Gtk as Gtk
    import           Network.HTTP.Simple hiding (Proxy)
    import           System.FilePath.Posix
    import           System.Taffybar.Context
    import           System.Taffybar.Information.Crypto hiding (symbol)
    import           System.Taffybar.Util
    import           System.Taffybar.Widget.Generic.AutoSizeImage
    import           System.Taffybar.Widget.Generic.ChannelWidget
    import           System.Taffybar.WindowIcon
    import           Text.Printf

    -- | Extends 'cryptoPriceLabel' with an icon corresponding to the symbol of the
    -- purchase crypto that will appear to the left of the price label. See the
    -- docstring for 'getCryptoPixbuf' for details about how this icon is retrieved.
    -- Note that automatic icon retrieval requires a coinmarketcap api key to be set
    -- at taffybar startup. As with 'cryptoPriceLabel', this function must be
    -- invoked with a type application with the type string that expresses the
    -- symbol of the relevant token and the underlying currency in which its price
    -- should be expressed. See the docstring of 'cryptoPriceLabel' for details
    -- about the exact format that this string should take.
    cryptoPriceLabelWithIcon :: forall a. KnownSymbol a => TaffyIO Gtk.Widget
    cryptoPriceLabelWithIcon :: forall (a :: Symbol). KnownSymbol a => TaffyIO Widget
    cryptoPriceLabelWithIcon = do
      Widget
    label <- forall (a :: Symbol). KnownSymbol a => TaffyIO Widget
    cryptoPriceLabel @a
      let symbolPair :: FilePath
    symbolPair = Proxy a -> FilePath
    forall (n :: Symbol) (proxy :: Symbol -> *).
    KnownSymbol n =>
    proxy n -> FilePath
    symbolVal (Proxy a
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy a)
          symbol :: FilePath
    symbol = [FilePath] -> FilePath
    forall a. HasCallStack => [a] -> a
    head ([FilePath] -> FilePath) -> [FilePath] -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath -> [FilePath]
    forall a. Eq a => [a] -> [a] -> [[a]]
    splitOn FilePath
    "-" FilePath
    symbolPair
      Box
    hbox <- Orientation -> Int32 -> ReaderT Context IO Box
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Orientation -> Int32 -> m Box
    Gtk.boxNew Orientation
    Gtk.OrientationHorizontal Int32
    0

      Context
    ctx <- ReaderT Context IO Context
    forall (m :: * -> *) r. Monad m => ReaderT r m r
    ask
      let refresh :: Int32 -> IO Pixbuf
    refresh =
            IO Pixbuf -> Int32 -> IO Pixbuf
    forall a b. a -> b -> a
    const (IO Pixbuf -> Int32 -> IO Pixbuf)
    -> IO Pixbuf -> Int32 -> IO Pixbuf
    forall a b. (a -> b) -> a -> b
    $ (ReaderT Context IO Pixbuf -> Context -> IO Pixbuf)
    -> Context -> ReaderT Context IO Pixbuf -> IO Pixbuf
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ReaderT Context IO Pixbuf -> Context -> IO Pixbuf
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT Context
    ctx (ReaderT Context IO Pixbuf -> IO Pixbuf)
    -> ReaderT Context IO Pixbuf -> IO Pixbuf
    forall a b. (a -> b) -> a -> b
    $
            Pixbuf -> Maybe Pixbuf -> Pixbuf
    forall a. a -> Maybe a -> a
    fromMaybe (Pixbuf -> Maybe Pixbuf -> Pixbuf)
    -> ReaderT Context IO Pixbuf
    -> ReaderT Context IO (Maybe Pixbuf -> Pixbuf)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int32 -> Word32 -> ReaderT Context IO Pixbuf
    forall (m :: * -> *). MonadIO m => Int32 -> Word32 -> m Pixbuf
    pixBufFromColor Int32
    10 Word32
    0 ReaderT Context IO (Maybe Pixbuf -> Pixbuf)
    -> ReaderT Context IO (Maybe Pixbuf) -> ReaderT Context IO Pixbuf
    forall a b.
    ReaderT Context IO (a -> b)
    -> ReaderT Context IO a -> ReaderT Context IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> FilePath -> ReaderT Context IO (Maybe Pixbuf)
    getCryptoPixbuf FilePath
    symbol
      Image
    image <- (Int32 -> IO Pixbuf) -> Orientation -> ReaderT Context IO Image
    forall (m :: * -> *).
    MonadIO m =>
    (Int32 -> IO Pixbuf) -> Orientation -> m Image
    autoSizeImageNew Int32 -> IO Pixbuf
    refresh Orientation
    Gtk.OrientationHorizontal

      Box -> Image -> ReaderT Context IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerAdd Box
    hbox Image
    image
      Box -> Widget -> ReaderT Context IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
    a -> b -> m ()
    Gtk.containerAdd Box
    hbox Widget
    label

      Box -> ReaderT Context IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    Gtk.widgetShowAll Box
    hbox

      Box -> TaffyIO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    Gtk.toWidget Box
    hbox

    newtype CMCAPIKey = CMCAPIKey String

    -- | Set the coinmarketcap.com api key that will be used for retrieving crypto
    -- icons that are not cached. This should occur before any attempts to retrieve
    -- crypto icons happen. The easiest way to call this appropriately is to set it
    -- as a 'startupHook'.
    setCMCAPIKey :: String -> TaffyIO CMCAPIKey
    setCMCAPIKey :: FilePath -> TaffyIO CMCAPIKey
    setCMCAPIKey FilePath
    key =
      TaffyIO CMCAPIKey -> TaffyIO CMCAPIKey
    forall t. Typeable t => Taffy IO t -> Taffy IO t
    getStateDefault (TaffyIO CMCAPIKey -> TaffyIO CMCAPIKey)
    -> TaffyIO CMCAPIKey -> TaffyIO CMCAPIKey
    forall a b. (a -> b) -> a -> b
    $ CMCAPIKey -> TaffyIO CMCAPIKey
    forall a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CMCAPIKey -> TaffyIO CMCAPIKey) -> CMCAPIKey -> TaffyIO CMCAPIKey
    forall a b. (a -> b) -> a -> b
    $ FilePath -> CMCAPIKey
    CMCAPIKey FilePath
    key

    -- | Build a label that will reflect the price of some token in some currency in
    -- the coingecko API. This function accepts these valuesas a type parameter with
    -- kind 'String' of the form `(symbol for asset being purchased)-(currency the
    -- price should be expressed in)`. For example, the product string for the price
    -- of bitcoin quoted in U.S. dollars is "BTC-USD". You can invoke this function
    -- by enabling the TypeApplications language extension and passing the string
    -- associated with the asset that you want to track as follows:
    --
    -- > cryptoPriceLabel @"BTC-USD"
    cryptoPriceLabel :: forall a. KnownSymbol a => TaffyIO Gtk.Widget
    cryptoPriceLabel :: forall (a :: Symbol). KnownSymbol a => TaffyIO Widget
    cryptoPriceLabel = forall (a :: Symbol).
    KnownSymbol a =>
    TaffyIO (CryptoPriceChannel a)
    getCryptoPriceChannel @a TaffyIO (CryptoPriceChannel a)
    -> (CryptoPriceChannel a -> TaffyIO Widget) -> TaffyIO Widget
    forall a b.
    ReaderT Context IO a
    -> (a -> ReaderT Context IO b) -> ReaderT Context IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= CryptoPriceChannel a -> TaffyIO Widget
    forall (a :: Symbol). CryptoPriceChannel a -> TaffyIO Widget
    cryptoPriceLabel'

    cryptoPriceLabel' :: CryptoPriceChannel a -> TaffyIO Gtk.Widget
    cryptoPriceLabel' :: forall (a :: Symbol). CryptoPriceChannel a -> TaffyIO Widget
    cryptoPriceLabel' (CryptoPriceChannel (BroadcastChan In CryptoPriceInfo
    chan, MVar CryptoPriceInfo
    var)) = do
      Label
    label <- Maybe Text -> ReaderT Context IO Label
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Maybe Text -> m Label
    Gtk.labelNew Maybe Text
    forall a. Maybe a
    Nothing
      let updateWidget :: CryptoPriceInfo -> IO ()
    updateWidget CryptoPriceInfo { lastPrice :: CryptoPriceInfo -> Double
    lastPrice = Double
    cryptoPrice } =
            IO () -> IO ()
    postGUIASync (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Label -> Text -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsLabel a) =>
    a -> Text -> m ()
    Gtk.labelSetMarkup Label
    label (Text -> IO ()) -> Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                         FilePath -> Text
    Data.Text.pack (FilePath -> Text) -> FilePath -> Text
    forall a b. (a -> b) -> a -> b
    $ Double -> FilePath
    forall a. Show a => a -> FilePath
    show Double
    cryptoPrice
      ReaderT Context IO SignalHandlerId -> ReaderT Context IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (ReaderT Context IO SignalHandlerId -> ReaderT Context IO ())
    -> ReaderT Context IO SignalHandlerId -> ReaderT Context IO ()
    forall a b. (a -> b) -> a -> b
    $ Label
    -> ((?self::Label) => IO ()) -> ReaderT Context IO SignalHandlerId
    forall a (m :: * -> *).
    (IsWidget a, MonadIO m) =>
    a -> ((?self::a) => IO ()) -> m SignalHandlerId
    Gtk.onWidgetRealize Label
    label (((?self::Label) => IO ()) -> ReaderT Context IO SignalHandlerId)
    -> ((?self::Label) => IO ()) -> ReaderT Context IO SignalHandlerId
    forall a b. (a -> b) -> a -> b
    $
           MVar CryptoPriceInfo -> IO CryptoPriceInfo
    forall a. MVar a -> IO a
    readMVar MVar CryptoPriceInfo
    var IO CryptoPriceInfo -> (CryptoPriceInfo -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= CryptoPriceInfo -> IO ()
    updateWidget
      Label -> TaffyIO Widget
    forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
    Gtk.toWidget (Label -> TaffyIO Widget)
    -> ReaderT Context IO Label -> TaffyIO Widget
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< Label
    -> BroadcastChan In CryptoPriceInfo
    -> (CryptoPriceInfo -> IO ())
    -> ReaderT Context IO Label
    forall (m :: * -> *) w a.
    (MonadIO m, IsWidget w) =>
    w -> BroadcastChan In a -> (a -> IO ()) -> m w
    channelWidgetNew Label
    label BroadcastChan In CryptoPriceInfo
    chan CryptoPriceInfo -> IO ()
    updateWidget

    cryptoIconsDir :: IO FilePath
    cryptoIconsDir :: IO FilePath
    cryptoIconsDir = (FilePath -> FilePath -> FilePath
    </> FilePath
    "crypto_icons") (FilePath -> FilePath) -> IO FilePath -> IO FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO FilePath
    taffyStateDir

    pathForCryptoSymbol :: String -> IO FilePath
    pathForCryptoSymbol :: FilePath -> IO FilePath
    pathForCryptoSymbol FilePath
    symbol =
      (FilePath -> FilePath -> FilePath
    </> FilePath -> FilePath -> FilePath
    forall r. PrintfType r => FilePath -> r
    printf FilePath
    "%s.png" FilePath
    symbol) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO FilePath
    cryptoIconsDir

    -- | Retrieve a pixbuf image corresponding to the provided crypto symbol. The
    -- image used will be retrieved from the file with the name `(pricesymbol).png`
    -- from the directory defined by 'cryptoIconsDir'. If a file is not found there
    -- and an an api key for coinmarketcap.com has been set using 'setCMCAPIKey', an
    -- icon will be automatically be retrieved from coinmarketcap.com.
    getCryptoPixbuf :: String -> TaffyIO (Maybe Gdk.Pixbuf)
    getCryptoPixbuf :: FilePath -> ReaderT Context IO (Maybe Pixbuf)
    getCryptoPixbuf = FilePath -> ReaderT Context IO (Maybe Pixbuf)
    forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe Pixbuf)
    getCryptoIconFromCache (FilePath -> ReaderT Context IO (Maybe Pixbuf))
    -> (FilePath -> ReaderT Context IO (Maybe Pixbuf))
    -> FilePath
    -> ReaderT Context IO (Maybe Pixbuf)
    forall (m :: * -> *) t a.
    Monad m =>
    (t -> m (Maybe a)) -> (t -> m (Maybe a)) -> t -> m (Maybe a)
    <||> FilePath -> ReaderT Context IO (Maybe Pixbuf)
    getCryptoIconFromCMC

    getCryptoIconFromCache :: MonadIO m => String -> m (Maybe Gdk.Pixbuf)
    getCryptoIconFromCache :: forall (m :: * -> *). MonadIO m => FilePath -> m (Maybe Pixbuf)
    getCryptoIconFromCache FilePath
    symbol = IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Maybe Pixbuf) -> m (Maybe Pixbuf))
    -> IO (Maybe Pixbuf) -> m (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $
      FilePath -> IO FilePath
    pathForCryptoSymbol FilePath
    symbol IO FilePath -> (FilePath -> IO (Maybe Pixbuf)) -> IO (Maybe Pixbuf)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= FilePath -> IO (Maybe Pixbuf)
    safePixbufNewFromFile

    getCryptoIconFromCMC :: String -> TaffyIO (Maybe Gdk.Pixbuf)
    getCryptoIconFromCMC :: FilePath -> ReaderT Context IO (Maybe Pixbuf)
    getCryptoIconFromCMC FilePath
    symbol =
      MaybeT (ReaderT Context IO) Pixbuf
    -> ReaderT Context IO (Maybe Pixbuf)
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT (ReaderT Context IO) Pixbuf
     -> ReaderT Context IO (Maybe Pixbuf))
    -> MaybeT (ReaderT Context IO) Pixbuf
    -> ReaderT Context IO (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $ do
        CMCAPIKey FilePath
    cmcAPIKey <- ReaderT Context IO (Maybe CMCAPIKey)
    -> MaybeT (ReaderT Context IO) CMCAPIKey
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT ReaderT Context IO (Maybe CMCAPIKey)
    forall t. Typeable t => Taffy IO (Maybe t)
    getState
        ReaderT Context IO (Maybe Pixbuf)
    -> MaybeT (ReaderT Context IO) Pixbuf
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (ReaderT Context IO (Maybe Pixbuf)
     -> MaybeT (ReaderT Context IO) Pixbuf)
    -> ReaderT Context IO (Maybe Pixbuf)
    -> MaybeT (ReaderT Context IO) Pixbuf
    forall a b. (a -> b) -> a -> b
    $ IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf)
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf))
    -> IO (Maybe Pixbuf) -> ReaderT Context IO (Maybe Pixbuf)
    forall a b. (a -> b) -> a -> b
    $ FilePath -> FilePath -> IO (Maybe Pixbuf)
    getCryptoIconFromCMC' FilePath
    cmcAPIKey FilePath
    symbol

    getCryptoIconFromCMC' :: String -> String -> IO (Maybe Gdk.Pixbuf)
    getCryptoIconFromCMC' :: FilePath -> FilePath -> IO (Maybe Pixbuf)
    getCryptoIconFromCMC' FilePath
    cmcAPIKey FilePath
    symbol = do
      ByteString
    jsonText <- FilePath -> FilePath -> IO ByteString
    forall (m :: * -> *).
    MonadIO m =>
    FilePath -> FilePath -> m ByteString
    getCryptoMeta FilePath
    cmcAPIKey FilePath
    symbol
      let uri :: Maybe Request
    uri = FilePath -> ByteString -> Maybe Text
    getIconURIFromJSON FilePath
    symbol ByteString
    jsonText Maybe Text -> (Text -> Maybe Request) -> Maybe Request
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= FilePath -> Maybe Request
    forall (m :: * -> *). MonadThrow m => FilePath -> m Request
    parseRequest (FilePath -> Maybe Request)
    -> (Text -> FilePath) -> Text -> Maybe Request
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> FilePath
    Data.Text.unpack
      FilePath
    path <- FilePath -> IO FilePath
    pathForCryptoSymbol FilePath
    symbol
      IO () -> (Request -> IO ()) -> Maybe Request -> IO ()
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) (Request -> FilePath -> IO ()
    `downloadURIToPath` FilePath
    path) Maybe Request
    uri
      FilePath -> IO (Maybe Pixbuf)
    safePixbufNewFromFile FilePath
    path

    getIconURIFromJSON :: String -> LBS.ByteString -> Maybe Data.Text.Text
    getIconURIFromJSON :: FilePath -> ByteString -> Maybe Text
    getIconURIFromJSON FilePath
    symbol ByteString
    jsonText =
      ByteString -> Maybe Object
    forall a. FromJSON a => ByteString -> Maybe a
    decode ByteString
    jsonText Maybe Object -> (Object -> Maybe Text) -> Maybe Text
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (Object -> Parser Text) -> Object -> Maybe Text
    forall a b. (a -> Parser b) -> a -> Maybe b
    parseMaybe
               ((Object -> Key -> Parser Object
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "data") (Object -> Parser Object)
    -> (Object -> Parser Text) -> Object -> Parser Text
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> (Object -> Key -> Parser Object
    forall a. FromJSON a => Object -> Key -> Parser a
    .: FilePath -> Key
    Key.fromString FilePath
    symbol) (Object -> Parser Object)
    -> (Object -> Parser Text) -> Object -> Parser Text
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> (Object -> Key -> Parser Text
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "logo"))