Skip to content

Commit

Permalink
[#31] Refactor and simplify CLI
Browse files Browse the repository at this point in the history
Resolves #31
  • Loading branch information
chshersh committed Nov 15, 2022
1 parent e8d6324 commit a921b1b
Show file tree
Hide file tree
Showing 13 changed files with 322 additions and 285 deletions.
1 change: 1 addition & 0 deletions .gitattributes
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
dr-cabal-debug.json linguist-generated=true
4 changes: 2 additions & 2 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -99,8 +99,8 @@ follow these steps:
> rm -rf ~/.cabal
> ```
>
> A less invasive approach is to point Cabal to a fresh store folder,
> but in this case you won't see the `Downloading` phase in the profiling
> A less invasive approach is to point Cabal to a fresh store folder,
> but in this case you won't see the `Downloading` phase in the profiling
> output:
>
> ```shell
Expand Down
6 changes: 0 additions & 6 deletions cabal.project

This file was deleted.

3 changes: 2 additions & 1 deletion dr-cabal.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -81,11 +81,12 @@ library
exposed-modules:
DrCabal
DrCabal.Cli
DrCabal.Interactive
DrCabal.Json
DrCabal.Model
DrCabal.Profile
DrCabal.Profile.Format
DrCabal.Profile.Stacked
DrCabal.Terminal
DrCabal.Watch

build-depends:
Expand Down
6 changes: 1 addition & 5 deletions src/DrCabal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,16 +14,12 @@ module DrCabal
) where

import DrCabal.Cli (Command (..), readCommand)
import DrCabal.Interactive (runInteractive)
import DrCabal.Profile (runProfile)
import DrCabal.Watch (runWatch)


main :: IO ()
main = readCommand >>= runDrCabal

runDrCabal :: Command -> IO ()
runDrCabal = \case
Watch args -> runWatch args
Profile args -> runProfile args
Interactive args -> runInteractive args
Profile args -> runProfile args
97 changes: 46 additions & 51 deletions src/DrCabal/Cli.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,32 +15,31 @@ module DrCabal.Cli
( Command (..)
, readCommand

, WatchArgs (..)
, ProfileArgs (..)
, InteractiveArgs (..)
, FileMode (..)
) where

import DrCabal.Model (Style (..))

import qualified Options.Applicative as Opt

data Command
= Watch WatchArgs
| Profile ProfileArgs
| Interactive InteractiveArgs

newtype WatchArgs = WatchArgs
{ watchArgsOutput :: FilePath
}
= Profile ProfileArgs

data ProfileArgs = ProfileArgs
{ profileArgsInput :: FilePath
, profileArgsStyle :: Style
{ profileArgsStyle :: Style
, profileArgsFileMode :: FileMode
}

newtype InteractiveArgs = InteractiveArgs
{ interactiveArgsStyle :: Style
}
data FileMode
-- | Don't read from the file and don't store the results in the file
= None

-- | Store current results in the file
| Output FilePath

-- | Read previously saved results from the file
| Input FilePath

readCommand :: IO Command
readCommand = Opt.execParser opts
Expand All @@ -53,48 +52,44 @@ readCommand = Opt.execParser opts

-- | All possible commands.
commandP :: Opt.Parser Command
commandP = Opt.subparser (mconcat
[ Opt.command "watch"
$ Opt.info (Opt.helper <*> watchP)
$ Opt.progDesc "Watch cabal output and save it"
, Opt.command "profile"
$ Opt.info (Opt.helper <*> profileP)
$ Opt.progDesc "Output pretty cabal profile results"
]) <|> interactiveP

watchP :: Opt.Parser Command
watchP = do
watchArgsOutput <- Opt.strOption $ mconcat
[ Opt.long "output"
, Opt.short 'o'
, Opt.metavar "FILE_PATH"
, Opt.help "Save cabal output to a file in a JSON format"
]

pure $ Watch WatchArgs{..}
commandP = Opt.subparser $ mconcat
[ Opt.command "profile"
$ Opt.info (Opt.helper <*> profileP)
$ Opt.progDesc "Build profiling report"
]

profileP :: Opt.Parser Command
profileP = do
profileArgsInput <- Opt.strOption $ mconcat
[ Opt.long "input"
, Opt.short 'i'
, Opt.metavar "FILE_PATH"
, Opt.help "Read profile input from a JSON file, created by 'dr-cabal watch'"
]

profileArgsStyle <- stackedP <|> pure Stacked
profileArgsStyle <- styleP
profileArgsFileMode <- fileModeP

pure $ Profile ProfileArgs{..}

interactiveP :: Opt.Parser Command
interactiveP = do
interactiveArgsStyle <- stackedP <|> pure Stacked
styleP :: Opt.Parser Style
styleP = stackedP <|> pure Stacked
where
stackedP :: Opt.Parser Style
stackedP = Opt.flag' Stacked $ mconcat
[ Opt.long "stacked"
, Opt.short 's'
, Opt.help "Format as stacked"
]

pure $ Interactive InteractiveArgs{..}
fileModeP :: Opt.Parser FileMode
fileModeP = inputP <|> outputP <|> pure None
where
inputP :: Opt.Parser FileMode
inputP = fmap Input $ Opt.strOption $ mconcat
[ Opt.long "input"
, Opt.short 'i'
, Opt.metavar "FILE_PATH"
, Opt.help "Read profile input from a JSON file, created by 'dr-cabal profile --output=<some-file>'"
]

stackedP :: Opt.Parser Style
stackedP = Opt.flag' Stacked $ mconcat
[ Opt.long "stacked"
, Opt.short 's'
, Opt.help "Format as stacked"
]
outputP :: Opt.Parser FileMode
outputP = fmap Output $ Opt.strOption $ mconcat
[ Opt.long "output"
, Opt.short 'o'
, Opt.metavar "FILE_PATH"
, Opt.help "Save cabal output to a file in a JSON format"
]
88 changes: 0 additions & 88 deletions src/DrCabal/Interactive.hs

This file was deleted.

39 changes: 39 additions & 0 deletions src/DrCabal/Json.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,39 @@
{- |
Module : DrCabal.Json
Copyright : (c) 2022 Dmitrii Kovanikov
SPDX-License-Identifier : MPL-2.0
Maintainer : Dmitrii Kovanikov <kovanikov@gmail.com>
Stability : Experimental
Portability : Portable
This module contains functions to process JSON entries recognised by @dr-cabal@.
-}

module DrCabal.Json
( readEntries
, writeEntries
) where

import Data.Aeson (eitherDecodeFileStrict')
import Data.Aeson.Encode.Pretty (encodePretty)

import DrCabal.Model (Entry)

import qualified Colourista


{- | Read a list of entries from a JSON file.
Exits process with an error message on decoding failure.
-}
readEntries :: FilePath -> IO [Entry]
readEntries file = eitherDecodeFileStrict' file >>= \case
Right entries -> pure entries
Left err -> do
Colourista.errorMessage $ "Error parsing file: " <> toText file
Colourista.redMessage $ " " <> toText err
exitFailure

-- | Write entries as a pretty JSON to the output file.
writeEntries :: FilePath -> [Entry] -> IO ()
writeEntries outputPath = writeFileLBS outputPath . encodePretty
21 changes: 21 additions & 0 deletions src/DrCabal/Model.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,10 +14,14 @@ module DrCabal.Model
, Line (..)
, Status (..)
, Entry (..)
, parseLine
) where

import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, withText, (.:), (.=))

import qualified Data.Text as Text


data Style = Stacked

data Line = Line
Expand Down Expand Up @@ -62,3 +66,20 @@ instance FromJSON Entry where
entryStart <- o .: "startTime"
entryLibrary <- o .: "library"
pure Entry{..}

parseLine :: Line -> Maybe Entry
parseLine Line{..} = do
let txtLine = decodeUtf8 lineLine
txtStatus : library : _ <- Just $ words txtLine

-- parse status string to the 'Status' type
status <- readMaybe $ toString txtStatus

-- check if this line is a library: '-' separates library name and its version
guard $ Text.elem '-' library

pure $ Entry
{ entryStatus = status
, entryStart = lineTime
, entryLibrary = library
}
Loading

0 comments on commit a921b1b

Please sign in to comment.