The scripting spree is not ended yet! To write the last few posts here I've fruitfully used "Scaffolding a Blog Post", "Tweeting a Blog Post via command line" and "Crossposting to DevTo via command line". Now it's time to see a script that was written for a work-related task.
In particular, we wanted to move a few of our project kanban boards from Kanbanery to Trello. Since I wrote the script after reading the awesome "Optics by Example", the code uses optics.
Let's see how the script works first:
$ ./kan2tre.hs --help
Usage: kan2tre.hs [--in CSV_FILE] TRELLO_BOARD_ID TRELLO_API_KEY
TRELLO_API_TOKEN
Moves all tickets exported from Kanbanery in CSV_FILE to the Trello board
identified by TRELLO_BOARD_ID. Kanbanery exports a CSV with the following
schema: Title,Owner email,Task type,Estimate,Priority,Description,Column
name,Creator email,Created at,Subtasks,Comments Some records exported by
Kanbanery could be malformed. When encountered they are printed to stdout so
that you can manually add them. Also, any failed request to the Trello API is
printed to stdout. Subtasks and comments are strings separated by semicolon.
Unfortunately, there's no way to distinguish between a separarator and a
semicolon in a comment / subtask. Thus, this script does not attempt to split
comments / subtasks. In other words, comments and subtasks are always going to
be one string each. This scripts ignores Owner email, Estimate, Priority,
Creator email and Created at.
Available options:
--in CSV_FILE Path to csv file with exported tickets from
Kanbanery (default: "./kanbanery.csv")
TRELLO_BOARD_ID Trello board id. To get this visit
https://trello.com/b/ID/reports.json where ID is the
one you see in the URL of your board. For example, in
the following URL the ID is 'lPbIpQIl'
https://trello.com/b/lPbIpQIl/habitatmap
TRELLO_API_KEY Trello api key
TRELLO_API_TOKEN Trello api token
-h,--help Show this help text
Here's code:
#!/usr/bin/env stack
{- stack
script
--resolver nightly-2019-12-21
--package wreq
--package optparse-applicative
--package aeson
--package bytestring
--package lens
--package filepath
--package time
--package cassava
--package text
--package split
--package lens-aeson
--package containers
--package mtl
--package unbounded-delays
--package transformers
--package optparse-applicative
--package http-client
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
import Network.Wreq
import Options.Applicative
import Data.Semigroup ((<>))
import Data.Aeson hiding ((.:))
import GHC.Generics
import Data.ByteString
import Data.ByteString.Char8
import Control.Lens hiding ((.=))
import System.FilePath.Posix
import Data.Foldable
import Data.Time
import Data.Time.Format.ISO8601
import qualified Data.ByteString.Lazy as BL
import Data.Csv
import Data.Text
import Data.List.Split
import Data.List
import Data.Aeson.Lens
import Data.Maybe
import Data.Map.Strict
import Control.Monad.State.Strict
import Data.Time.Clock.POSIX
import Control.Concurrent.Thread.Delay
import Control.Monad.Trans.Reader
import Control.Exception
import Network.HTTP.Client
import Data.Text.Lens
data KanbaneryTicket =
KanbaneryTicket
{ _kanbaneryTicketTitle :: String
, _kanbaneryTicketOwnerEmail :: String
, _kanbaneryTicketTaskType :: String
, _kanbaneryTicketEstimate :: Maybe Float
, _kanbaneryTicketPriority :: Maybe Float
, _kanbaneryTicketDescription :: String
, _kanbaneryTicketColumnName :: String
, _kanbaneryTicketCreatorEmail :: String
, _kanbaneryTicketCreatedAt :: NominalDiffTime
, _kanbaneryTicketSubtasks :: String
, _kanbaneryTicketComments :: String
} deriving (Show,Eq,Ord)
makeFields ''KanbaneryTicket
-- ^ Generate accessors for each field of the record.
-- That means we can later do stuff like
-- `kanbaneryTicket ^. title` to "view" the title
-- without having to worry about duplicate record fields.
data KanbaneryTicketParseResult
= Ok KanbaneryTicket
| Malformed String
deriving (Show)
makePrisms ''KanbaneryTicketParseResult
-- ^ Generate a Prism for each constructor of a data type.
-- See later uses of `_Ok` or `_Malformed`.
instance FromNamedRecord KanbaneryTicketParseResult where
-- ^ Tell cassava how to convert a CSV record to KanbaneryTicketParseResult.
parseNamedRecord x
| Data.Foldable.length x == 11 = Ok <$> parsed
-- ^ When the CSV record has all the fields then..
-- ^ ..it's wellformed..
| otherwise = pure . Malformed $ show x
-- ^ ..otherwise..
-- ^ ..it's malformed.
where
parsed =
KanbaneryTicket <$>
(x .: "Title") <*>
(x .: "Owner email") <*>
(x .: "Task type") <*>
(x .: "Estimate") <*>
(x .: "Priority") <*>
(x .: "Description") <*>
(x .: "Column name") <*>
(x .: "Creator email") <*>
fmap (utcTimeToPOSIXSeconds . zonedTimeToUTC) (x .: "Created at") <*>
(x .: "Subtasks") <*>
(x .: "Comments")
instance FromField ZonedTime where
parseField s = do
mzt <- iso8601ParseM <$> parseField s
Data.Maybe.maybe mempty pure mzt
data Opts =
Opts
{ _optsCsvFile :: String
, _optsTrelloBoardId :: String
, _optsTrelloApiKey :: String
, _optsTrelloToken :: String
} deriving (Show)
makeFields ''Opts
data Env
= Env
{ _envTrelloBoardId :: String
, _envTrelloApiKey :: String
, _envTrelloToken :: String
} deriving (Show)
makeFields ''Env
type App a = ReaderT Env IO a
-- ^ Our application runs in an environment where it can..
-- ^ ..read `Env` (i.e. board id, api key and Trello token)..
-- ^ ..perform IO..
-- ^ ..return a result of type a.
main :: IO ()
main = do
o <- execParser opts
-- ^ Get command line input. More on this in the previous posts.
let env = Env (o ^. trelloBoardId) (o ^. trelloApiKey) (o ^. trelloToken)
-- ^ Wrap command line input into `Env`.
Control.Monad.Trans.Reader.runReaderT (run $ o ^. csvFile) env
-- ^ Apply `env` to `run`.
where
opts = info (parser <**> helper)
( fullDesc
<> progDesc "Moves all tickets exported from Kanbanery in CSV_FILE to the Trello board identified by TRELLO_BOARD_ID. \
\ \
\Kanbanery exports a CSV with the following schema: \
\Title,Owner email,Task type,Estimate,Priority,Description,Column name,Creator email,Created at,Subtasks,Comments \
\ \
\Some records exported by Kanbanery could be malformed. When encountered they are printed to stdout \
\so that you can manually add them. \
\ \
\Also, any failed request to the Trello API is printed to stdout. \
\ \
\Subtasks and comments are strings separated by semicolon. \
\Unfortunately, there's no way to distinguish between a separarator and a semicolon in a comment / subtask. \
\Thus, this script does not attempt to split comments / subtasks. In other words, comments and subtasks \
\are always going to be one string each. \
\ \
\This scripts ignores Owner email, Estimate, Priority, Creator email and Created at."
)
parser :: Options.Applicative.Parser Opts
parser = Opts
<$> strOption
( long "in"
<> metavar "CSV_FILE"
<> help "Path to csv file with exported tickets from Kanbanery"
<> value "./kanbanery.csv"
<> showDefault
)
<*> Options.Applicative.argument str
( metavar "TRELLO_BOARD_ID"
<> help "Trello board id. To get this visit https://trello.com/b/ID/reports.json \
\where ID is the one you see in the URL of your board. For example, in the \
\following URL the ID is 'lPbIpQIl' https://trello.com/b/lPbIpQIl/habitatmap"
)
<*> Options.Applicative.argument str
( metavar "TRELLO_API_KEY"
<> help "Trello api key"
)
<*> Options.Applicative.argument str
( metavar "TRELLO_API_TOKEN"
<> help "Trello api token"
)
run :: String -> App ()
run csvFile = do
csv <- liftIO $ Data.ByteString.Lazy.readFile csvFile
-- ^ Read the CSV file.
-- ^ We need to liftIO because we are in the `App` monad transformer with IO as the base.
case decodeByName csv of
Left err -> liftIO . error . show $ err
-- ^ If the content of the file cannot be decoded by cassava then exit.
Right (_,records) -> do
let malformed = records ^.. folded . _Malformed
-- ^ Take all the `Malformed` records and..
liftIO $ Prelude.putStrLn $ "Found " <> (show . Data.Foldable.length $ malformed) <> " malformed records."
traverse_ (liftIO . Prelude.putStrLn . (<>) "MALFORMED: ") malformed
-- ^ ..print some info about them so that they can be manually transferred to Trello.
let kanbaneryTickets = records ^.. folded . _Ok
-- ^ Take all the wellformed (i.e. `Ok`) records and..
liftIO $ Prelude.putStrLn $ "Creating " <> (show . Data.Foldable.length $ kanbaneryTickets) <> " tickets."
liftIO $ Prelude.putStrLn "Creating lists."
columnNamesByListIds <- createLists kanbaneryTickets
-- ^ ..create in Trello the same columns that are on Kanbanery..
liftIO $ Prelude.putStrLn "" >> Prelude.putStrLn "Creating cards."
kanbaneryTicketsByCardId <- createCards columnNamesByListIds kanbaneryTickets
-- ^ ..create in Trello the tickets that are on Kanbanery..
liftIO $ Prelude.putStrLn "" >> Prelude.putStrLn "Creating labels."
labelsByIds <- createLabels kanbaneryTickets
-- ^ ..create in Trello the labels that are on Kanbanery..
liftIO $ Prelude.putStrLn "" >> Prelude.putStrLn "Adding labels to tickets."
traverse_ (addLabelsReq labelsByIds kanbaneryTicketsByCardId) kanbaneryTickets
-- ^ ..associate labels to tickets in Trello..
liftIO $ Prelude.putStrLn "" >> Prelude.putStrLn "Adding subtasks to tickets."
traverse_ (addSubtasksReq kanbaneryTicketsByCardId) kanbaneryTickets
-- ^ ..add subtasks that were in Kanbanery tickets to Trello tickets..
liftIO $ Prelude.putStrLn "" >> Prelude.putStrLn "Adding creator email and creation date to tickets."
traverse_ (addCreationReq kanbaneryTicketsByCardId) kanbaneryTickets
-- ^ ..for each ticket add the Kanbanery creation date as a comment..
liftIO $ Prelude.putStrLn "" >> Prelude.putStrLn "Adding comments to tickets."
traverse_ (addCommentsReq kanbaneryTicketsByCardId) kanbaneryTickets
-- ^ ..add comments that were in Kanbanery tickets to Trello tickets.
liftIO $ Prelude.putStrLn "" >> Prelude.putStrLn "Done!"
createLists :: [KanbaneryTicket] -> App (Map String String)
createLists kanbaneryTickets = do
let columnNames = Data.List.nub . Data.List.sort . toListOf (folded.columnName) $ kanbaneryTickets
-- ^ From each ticket extract `columnName`.
Data.Map.Strict.fromList . Data.Maybe.catMaybes <$> traverse f columnNames
where
f columnName = do
-- ^ Create column / list in Trello.
mId <- createListReq columnName
case mId of
Just id -> pure $ Just (columnName,id)
-- ^ When successful..
-- ^ ..return `columnName` and its Trello id.
Nothing -> pure Nothing
createListReq :: String -> App (Maybe String)
createListReq list = do
env <- Control.Monad.Trans.Reader.ask
let opts = defaults & Network.Wreq.param "name" .~ [Data.Text.pack list]
& Network.Wreq.param "idBoard" .~ [env ^. trelloBoardId . packed]
-- ^ Using optics..
-- ^ ..extract `trelloBoardId` and..
-- ^ ..transform to Text.
postReq opts "https://api.trello.com/1/lists"
createCards :: Map String String -> [KanbaneryTicket] -> App (Map KanbaneryTicket String)
createCards columnNamesByListIds kanbaneryTickets =
Data.Map.Strict.fromList . Data.Maybe.catMaybes <$> traverse f kanbaneryTickets
where
f kanbaneryTicket = do
-- ^ Create ticket in Trello.
let listId = columnNamesByListIds ^?! ix (kanbaneryTicket ^. columnName)
-- ^ Using optics..
-- ^ ..extract **UNSAFELY**..
-- ^ ..the value from the Map at the key..
-- ^ ..`columnName`.
mId <- createCardReq listId (kanbaneryTicket ^. title) (kanbaneryTicket ^. description)
case mId of
Just id -> pure $ Just (kanbaneryTicket,id)
Nothing -> pure Nothing
createCardReq :: String -> String -> String -> App (Maybe String)
createCardReq idList title description = do
let opts = defaults & Network.Wreq.param "name" .~ [Data.Text.pack title]
& Network.Wreq.param "desc" .~ [Data.Text.pack description]
& Network.Wreq.param "idList" .~ [Data.Text.pack idList]
postReq opts "https://api.trello.com/1/cards"
createLabels :: [KanbaneryTicket] -> App (Map String String)
createLabels kanbaneryTickets = do
let taskTypes = Data.List.nub . Data.List.sort . toListOf (folded.taskType) $ kanbaneryTickets
let colors = Data.List.cycle ["yellow", "purple", "blue", "red", "green", "orange", "black", "sky", "pink", "lime"]
Data.Map.Strict.fromList . Data.Maybe.catMaybes <$> traverse f (Data.List.zip taskTypes colors)
where
f (label,color) = do
mId <- createLabelReq label color
case mId of
Just id -> pure $ Just (label,id)
Nothing -> pure Nothing
createLabelReq :: String -> String -> App (Maybe String)
createLabelReq label color = do
env <- Control.Monad.Trans.Reader.ask
let opts = defaults & Network.Wreq.param "name" .~ [Data.Text.pack label]
& Network.Wreq.param "color" .~ [Data.Text.pack color]
& Network.Wreq.param "idBoard" .~ [env ^. trelloBoardId . packed]
postReq opts "https://api.trello.com/1/labels"
addLabelsReq :: Map String String -> Map KanbaneryTicket String -> KanbaneryTicket -> App ()
addLabelsReq labels tickets kanbaneryTicket =
case labels ^? ix (kanbaneryTicket ^. taskType) of
Just name -> do
let opts = defaults & Network.Wreq.param "value" .~ [Data.Text.pack name]
case tickets ^? ix kanbaneryTicket of
Just id -> do
postReq opts ("https://api.trello.com/1/cards/" <> id <> "/idLabels")
pure ()
Nothing ->
pure ()
Nothing ->
pure ()
addSubtasksReq :: Map KanbaneryTicket String -> KanbaneryTicket -> App ()
addSubtasksReq tickets kanbaneryTicket =
when (has folded $ kanbaneryTicket ^. subtasks) $
-- ^ When there's at least on subtask..
case tickets ^? ix kanbaneryTicket of
Just cardId -> do
let opts = defaults & Network.Wreq.param "idCard" .~ [Data.Text.pack cardId]
mCheckId <- postReq opts "https://api.trello.com/1/checklists"
-- ^ ..create a Trello checklist and..
case mCheckId of
Just checkId -> do
let opts2 = defaults & Network.Wreq.param "name" .~ [kanbaneryTicket ^. subtasks . packed]
postReq opts2 ("https://api.trello.com/1/checklists/" <> checkId <> "/checkItems")
-- ^ ..add all the subtasks.
pure ()
Nothing -> pure ()
Nothing -> pure ()
addCreationReq :: Map KanbaneryTicket String -> KanbaneryTicket -> App ()
addCreationReq tickets kanbaneryTicket =
case tickets ^? ix kanbaneryTicket of
Just id -> do
let creator = kanbaneryTicket ^. creatorEmail
let date = formatTime defaultTimeLocale "%F" . posixSecondsToUTCTime . view createdAt $ kanbaneryTicket
let opts = defaults & Network.Wreq.param "text" .~ [Data.Text.pack $ "Created by " <> creator <> " on " <> date]
postReq opts ("https://api.trello.com/1/cards/" <> id <> "/actions/comments")
pure ()
Nothing ->
pure ()
addCommentsReq :: Map KanbaneryTicket String -> KanbaneryTicket -> App ()
addCommentsReq tickets kanbaneryTicket =
when (has folded $ kanbaneryTicket ^. comments) $
case tickets ^? ix kanbaneryTicket of
Just id -> do
let opts = defaults & Network.Wreq.param "text" .~ [kanbaneryTicket ^. comments . packed]
postReq opts ("https://api.trello.com/1/cards/" <> id <> "/actions/comments")
pure ()
Nothing ->
pure ()
postReq :: Network.Wreq.Options -> String -> App (Maybe String)
postReq opts url = do
env <- Control.Monad.Trans.Reader.ask
let opts' = opts & Network.Wreq.param "key" .~ [env ^. trelloApiKey . packed]
& Network.Wreq.param "token" .~ [env ^. trelloToken . packed]
& Network.Wreq.header "Accept" .~ ["application/json"]
& Network.Wreq.header "Content-Type" .~ ["application/json"]
liftIO $ delay 35000
-- ^ Throttle requests to respect Trello API rate limits.
liftIO $ Control.Exception.handle (handler opts') $ do
-- ^ In case of exception run `handler`.
r <- liftIO $ Network.Wreq.postWith opts' url ("" :: ByteString)
liftIO $ Prelude.putStr "."
let resourceId = r ^?! Network.Wreq.responseBody .
Data.Aeson.Lens.key "id" .
Data.Aeson.Lens._String .
unpacked
pure . Just $ resourceId
where
handler :: Network.Wreq.Options -> HttpException -> IO (Maybe String)
handler opts' _ = do
-- ^ In case of exception log it and return failure (i.e. Nothing).
liftIO . Prelude.putStrLn $ "Failed POST to " <> url
liftIO . print $ opts'
pure Nothing