Meme clipboard copier with Rofi

config.dhall

let Meme =
      { Type = { path : Text, description : Text, slug : Text }, default = {=} }

let basePath = "/home/thales/Pictures/zoeira/"

let memePath = λ(file : Text) → basePath ++ file

let memes =
      [ Meme::{
        , path = memePath "eyebrows.gif"
        , description = "sobrancelhas eyebrows"
        , slug = "eyebrows"
        }
      , Meme::{
        , path = memePath "hmmm.png"
        , description = "buzz lightyear hmmm"
        , slug = "hmmm"
        }
      , Meme::{
        , path = memePath "railroad_meatcanyon_turn.gif"
        , description = "meatcanyon farthest start railroad"
        , slug = "farthest_star"
        }
      , Meme::{
        , path = memePath "bullet_bill.gif"
        , description = "bullet bill raining bombing"
        , slug = "bullet_bill"
        }
      , Meme::{
        , path = memePath "xp_task_failed_successfully.jpg"
        , description = "xp task failed successfully"
        , slug = "task_failed_successfully"
        }
      ]

in  memes

memefi.hs

#!/usr/bin/env stack
{-
  stack --resolver lts-16.19 script
    --compile
    --ghc-options "-threaded"
    --package turtle
    --package dhall
    --package text
    --package containers
-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE NamedFieldPuns      #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import qualified Data.Map  as M
import           Data.Text (intercalate, pack, splitOn)
import           Dhall
import           Turtle


data Meme = MkMeme { path        :: Prelude.FilePath
                   , description :: Text
                   , slug        :: Text
                   }
            deriving (Show, Generic)

instance FromDhall Meme

memeToLine :: Meme -> Text
memeToLine MkMeme{description, slug} = slug <> " " <> description

copyToClipboard :: Text -> IO ()
copyToClipboard chosenPath =
  procs "xclip"
        [ "-i"
        , "-se"
        , "c"
        , "-t"
        , "image/png"
        , chosenPath
        ]
        empty

callRofi :: M.Map Text Meme -> IO Text
callRofi memeIndex = do
  let inputs = select
               . textToLines
               . intercalate "|"
               . fmap memeToLine
               . M.elems
               $ memeIndex
  (ExitSuccess, res) <- procStrict "rofi"
                                   [ "-sep"
                                   , "|"
                                   , "-dmenu"
                                   , "-p"
                                   , "memes"
                                   ]
                                   inputs
  let (chosenSlug : _) = splitOn " " res
      MkMeme{path = chosenPath} = memeIndex M.! chosenSlug
  pure . pack $ chosenPath

main :: IO ()
main = do
  memes :: [Meme] <- Dhall.input auto "~/.config/memefi/config.dhall"
  let memeIndex = M.fromList
                  . fmap (\meme@MkMeme{slug} -> (slug, meme))
                  $ memes
  chosen <- callRofi memeIndex
  copyToClipboard chosen