add fourmolu config; reformat using fourmolu
This commit is contained in:
parent
dfe275eedf
commit
74f96dc563
31
app/Main.hs
31
app/Main.hs
|
@ -2,11 +2,12 @@ module Main where
|
|||
|
||||
import Data.Text as T
|
||||
import Data.Text.IO as T
|
||||
|
||||
-- import Data.Time.Clock
|
||||
import Data.Time.LocalTime
|
||||
import NCDeck
|
||||
import Options.Applicative
|
||||
import System.IO
|
||||
import NCDeck
|
||||
|
||||
data Options = Options
|
||||
{ hostname :: Text
|
||||
|
@ -55,7 +56,8 @@ run (Options {..}) = do
|
|||
parseListStacks :: Parser Command
|
||||
parseListStacks =
|
||||
ListStacks
|
||||
<$> option auto
|
||||
<$> option
|
||||
auto
|
||||
( long "board-id"
|
||||
<> short 'b'
|
||||
<> metavar "BOARD_ID"
|
||||
|
@ -65,13 +67,15 @@ parseListStacks =
|
|||
parseListCards :: Parser Command
|
||||
parseListCards =
|
||||
ListCards
|
||||
<$> option auto
|
||||
<$> option
|
||||
auto
|
||||
( long "board-id"
|
||||
<> short 'b'
|
||||
<> metavar "BOARD_ID"
|
||||
<> help "the id of the kanban board"
|
||||
)
|
||||
<*> option auto
|
||||
<*> option
|
||||
auto
|
||||
( long "stack-id"
|
||||
<> short 's'
|
||||
<> metavar "STACK_ID"
|
||||
|
@ -81,13 +85,15 @@ parseListCards =
|
|||
parseCreateCard :: Parser Command
|
||||
parseCreateCard =
|
||||
CreateCard
|
||||
<$> option auto
|
||||
<$> option
|
||||
auto
|
||||
( long "board-id"
|
||||
<> short 'b'
|
||||
<> metavar "BOARD_ID"
|
||||
<> help "the id of the kanban board"
|
||||
)
|
||||
<*> option auto
|
||||
<*> option
|
||||
auto
|
||||
( long "stack-id"
|
||||
<> short 's'
|
||||
<> metavar "STACK_ID"
|
||||
|
@ -107,19 +113,22 @@ parseCreateCard =
|
|||
<> showDefault
|
||||
<> help "the card's description"
|
||||
)
|
||||
<*> option auto
|
||||
<*> option
|
||||
auto
|
||||
( long "date" -- FIXME: make this optional?
|
||||
<> short 'e'
|
||||
<> metavar "DATE"
|
||||
<> help "the card's date, format: YYYY-MM-DD hh:mm:ss"
|
||||
)
|
||||
<*> option auto
|
||||
<*> option
|
||||
auto
|
||||
( long "weekly-repeats"
|
||||
<> short 'w'
|
||||
<> metavar "COUNT"
|
||||
<> value 0
|
||||
<> showDefault
|
||||
<> help "repeat the card weekly COUNT times")
|
||||
<> help "repeat the card weekly COUNT times"
|
||||
)
|
||||
|
||||
parseOptions :: Parser Options
|
||||
parseOptions =
|
||||
|
@ -146,7 +155,9 @@ parseOptions =
|
|||
main :: IO ()
|
||||
main = run =<< execParser opts
|
||||
where
|
||||
opts = info (parseOptions <**> helper)
|
||||
opts =
|
||||
info
|
||||
(parseOptions <**> helper)
|
||||
( fullDesc
|
||||
<> progDesc "Manage a Nextcloud Deck"
|
||||
<> header "ncdeck - Manage a Nextcloud Deck"
|
||||
|
|
|
@ -0,0 +1,16 @@
|
|||
indentation: 2
|
||||
column-limit: none
|
||||
function-arrows: leading
|
||||
comma-style: leading
|
||||
import-export-style: leading
|
||||
indent-wheres: true
|
||||
record-brace-space: true
|
||||
newline-between-decls: true
|
||||
haddock-style: multi-line
|
||||
haddock-style-module: null
|
||||
let-style: newline
|
||||
in-style: left-align
|
||||
single-constraint-parens: always
|
||||
single-deriving-parens: always
|
||||
unicode: never
|
||||
respectful: true
|
109
src/NCDeck.hs
109
src/NCDeck.hs
|
@ -8,21 +8,23 @@ module NCDeck
|
|||
, createCard
|
||||
) where
|
||||
|
||||
import Prelude hiding (id)
|
||||
import Data.Aeson
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.Encoding as T
|
||||
import Data.Text qualified as T
|
||||
import Data.Text.Encoding qualified as T
|
||||
import Prelude hiding (id)
|
||||
|
||||
-- import Data.Time.Clock
|
||||
import Data.Time.LocalTime
|
||||
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Data.Time.Calendar
|
||||
import Data.Time.Calendar.OrdinalDate
|
||||
import Data.Time.Clock.POSIX (POSIXTime)
|
||||
import Data.Time.LocalTime
|
||||
import GHC.Generics
|
||||
import Network.HTTP.Req
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
|
||||
data Board = Board
|
||||
{ id :: Int
|
||||
|
@ -30,7 +32,8 @@ data Board = Board
|
|||
, deletedAt :: POSIXTime
|
||||
, lastModified :: POSIXTime
|
||||
, archived :: Bool
|
||||
} deriving Generic
|
||||
}
|
||||
deriving (Generic)
|
||||
|
||||
data Stack = Stack
|
||||
{ id :: Int
|
||||
|
@ -39,38 +42,58 @@ data Stack = Stack
|
|||
, deletedAt :: POSIXTime
|
||||
, lastModified :: POSIXTime
|
||||
, cards :: Maybe [Card]
|
||||
} deriving Generic
|
||||
}
|
||||
deriving (Generic)
|
||||
|
||||
data Card = Card
|
||||
{ id :: Int
|
||||
, title :: Text
|
||||
, description :: Text
|
||||
, duedate :: Maybe LocalTime
|
||||
} deriving Generic
|
||||
}
|
||||
deriving (Generic)
|
||||
|
||||
instance FromJSON Board
|
||||
|
||||
instance Show Board where
|
||||
show :: Board -> String
|
||||
show (Board {..}) =
|
||||
T.unpack title <> "\n" <>
|
||||
"------------------------------------------------------\n" <>
|
||||
"id:\t\t" <> show id <> "\n" <>
|
||||
"last modified:\t" <> show lastModified <> "\n" <>
|
||||
"deleted at:\t" <> show deletedAt <> "\n" <>
|
||||
"archived: \t" <> show archived <> "\n"
|
||||
T.unpack title
|
||||
<> "\n"
|
||||
<> "------------------------------------------------------\n"
|
||||
<> "id:\t\t"
|
||||
<> show id
|
||||
<> "\n"
|
||||
<> "last modified:\t"
|
||||
<> show lastModified
|
||||
<> "\n"
|
||||
<> "deleted at:\t"
|
||||
<> show deletedAt
|
||||
<> "\n"
|
||||
<> "archived: \t"
|
||||
<> show archived
|
||||
<> "\n"
|
||||
|
||||
instance FromJSON Stack
|
||||
|
||||
instance Show Stack where
|
||||
show :: Stack -> String
|
||||
show (Stack {..}) =
|
||||
T.unpack title <> "\n" <>
|
||||
"------------------------------------------------------\n" <>
|
||||
"id:\t\t" <> show id <> "\n" <>
|
||||
"last modified:\t" <> show lastModified <> "\n" <>
|
||||
"deleted at:\t" <> show deletedAt <> "\n" <>
|
||||
"#cards: \t" <> show (length cards) <> "\n"
|
||||
T.unpack title
|
||||
<> "\n"
|
||||
<> "------------------------------------------------------\n"
|
||||
<> "id:\t\t"
|
||||
<> show id
|
||||
<> "\n"
|
||||
<> "last modified:\t"
|
||||
<> show lastModified
|
||||
<> "\n"
|
||||
<> "deleted at:\t"
|
||||
<> show deletedAt
|
||||
<> "\n"
|
||||
<> "#cards: \t"
|
||||
<> show (length cards)
|
||||
<> "\n"
|
||||
|
||||
instance FromJSON Card
|
||||
|
||||
|
@ -81,15 +104,23 @@ instance Show Card where
|
|||
desc = T.unpack $ truncateDesc description
|
||||
dd = maybe "None" show duedate
|
||||
in
|
||||
T.unpack title <> "\n" <>
|
||||
"----------------------------------------------------\n" <>
|
||||
"id:\t\t" <> show id <> "\n" <>
|
||||
"description: \t" <> desc <> "\n" <>
|
||||
"due date: \t" <> dd <> "\n"
|
||||
T.unpack title
|
||||
<> "\n"
|
||||
<> "----------------------------------------------------\n"
|
||||
<> "id:\t\t"
|
||||
<> show id
|
||||
<> "\n"
|
||||
<> "description: \t"
|
||||
<> desc
|
||||
<> "\n"
|
||||
<> "due date: \t"
|
||||
<> dd
|
||||
<> "\n"
|
||||
where
|
||||
truncateDesc :: Text -> Text
|
||||
truncateDesc input =
|
||||
let (fstLine, _) = T.break (== '\n') input
|
||||
let
|
||||
(fstLine, _) = T.break (== '\n') input
|
||||
in
|
||||
if T.length fstLine > 30
|
||||
then T.take 30 fstLine <> "..."
|
||||
|
@ -100,7 +131,8 @@ authHeaders username password =
|
|||
let
|
||||
usernameBS = T.encodeUtf8 username
|
||||
passwordBS = T.encodeUtf8 password
|
||||
in header "OCS-APIRequest" "true" <> basicAuth usernameBS passwordBS
|
||||
in
|
||||
header "OCS-APIRequest" "true" <> basicAuth usernameBS passwordBS
|
||||
|
||||
baseUrl :: Text -> Url Https
|
||||
baseUrl hostname =
|
||||
|
@ -111,7 +143,8 @@ listBoards hostname username password =
|
|||
let
|
||||
headers = authHeaders username password
|
||||
url = baseUrl hostname /: "boards"
|
||||
in runReq defaultHttpConfig $ do
|
||||
in
|
||||
runReq defaultHttpConfig $ do
|
||||
response <- req GET url NoReqBody jsonResponse headers
|
||||
return $ responseBody response
|
||||
|
||||
|
@ -120,7 +153,8 @@ listStacks hostname username password boardId =
|
|||
let
|
||||
headers = authHeaders username password
|
||||
url = baseUrl hostname /: "boards" /: T.pack (show boardId) /: "stacks"
|
||||
in runReq defaultHttpConfig $ do
|
||||
in
|
||||
runReq defaultHttpConfig $ do
|
||||
response <- req GET url NoReqBody jsonResponse headers
|
||||
return $ responseBody response
|
||||
|
||||
|
@ -129,9 +163,11 @@ listCards hostname username password boardId stackId =
|
|||
let
|
||||
headers = authHeaders username password
|
||||
url = baseUrl hostname /: "boards" /: T.pack (show boardId) /: "stacks" /: T.pack (show stackId)
|
||||
in runReq defaultHttpConfig $ do
|
||||
in
|
||||
runReq defaultHttpConfig $ do
|
||||
response <- req GET url NoReqBody jsonResponse headers
|
||||
let stack :: Stack = responseBody response
|
||||
let
|
||||
stack :: Stack = responseBody response
|
||||
return $ fromMaybe [] stack.cards
|
||||
|
||||
createCard :: Text -> Text -> Text -> Word -> Word -> Text -> Text -> LocalTime -> Word -> IO ()
|
||||
|
@ -143,10 +179,11 @@ createCard hostname username password boardId stackId title description date wee
|
|||
(_, dayOfYear) = toOrdinalDate date.localDay
|
||||
(year, month, day) = toGregorian date.localDay
|
||||
expandedTitle =
|
||||
T.replace "%YY" (T.pack $ show year) $
|
||||
T.replace "%MM" (T.pack $ show month) $
|
||||
T.replace "%DD" (T.pack $ show day) title
|
||||
body = object
|
||||
T.replace "%YY" (T.pack $ show year)
|
||||
$ T.replace "%MM" (T.pack $ show month)
|
||||
$ T.replace "%DD" (T.pack $ show day) title
|
||||
body =
|
||||
object
|
||||
[ "title" .= expandedTitle
|
||||
, "type" .= ("plain" :: Text)
|
||||
, "order" .= dayOfYear
|
||||
|
|
Loading…
Reference in New Issue