Commit b4cb3bed authored by Hans-Peter Deifel's avatar Hans-Peter Deifel 🐢

Fix warnings

parent e2800e3e
......@@ -3,24 +3,18 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE NumDecimals #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
module Main (main) where
import Control.Arrow ((***))
import Control.Exception (evaluate)
import Control.Monad (forM_)
import Control.Monad.ST
import Data.IORef
import Data.List (sortBy, transpose)
import Data.Ord (comparing)
import Data.Semigroup hiding (option)
import System.CPUTime
import Data.List (sortOn)
import System.Exit
import System.IO
import System.Environment
import Data.Scientific
import Data.Map (Map)
import qualified Data.Map as M
......@@ -52,7 +46,7 @@ import Copar.Timing
-- CLI Options
----------------------------------------------------------------------
data Options = Options
newtype Options = Options
{ optCommand :: SubCommand }
data SubCommand
......@@ -395,24 +389,24 @@ main = do
withTimeStat stats "overall-duration" $ do
(f, (symbolTable, encoding)) <- withTimeStat stats "parse-duration" $ do
let transPolicy = if (refineApplyTransformations r)
let transPolicy = if refineApplyTransformations r
then P.ApplyTransformations
else P.DontApplyTransformations
let sanity = if (refineEnableSanity r)
let sanity = if refineEnableSanity r
then P.EnableSanityChecks
else P.DisableSanityChecks
let parserConfig = P.Config
{ functorTransforms = transPolicy
, sanityChecks = sanity
, functor = (refineFunctor r)
, functor = refineFunctor r
}
readCoalgebra parserConfig (refineInputFile r)
>>= \case
Left err -> hPutStrLn stderr err >> exitFailure
Right res -> evaluate $ res
Right res -> evaluate res
logStat stats "states" (tshow (Encoding.size encoding))
logStat stats "edges" (tshow (Encoding.numEdges encoding))
......@@ -429,7 +423,7 @@ main = do
_ -> do
(part, algoStats) <-
withTimeStat stats "algorithm-duration"
$ (refineWithStats f encoding (refineEnableOpt r))
$ refineWithStats f encoding (refineEnableOpt r)
logStat stats
"initial-partition-size"
(tshow (initialBlocks algoStats))
......@@ -462,7 +456,7 @@ main = do
(GraphCommand r) -> do
(f, (symbolTable, encoding)) <- do
let transPolicy = if (graphApplyTransformations r)
let transPolicy = if graphApplyTransformations r
then P.ApplyTransformations
else P.DontApplyTransformations
......@@ -473,10 +467,10 @@ main = do
readCoalgebra parserConfig (graphInputFile r) >>= \case
Left err -> hPutStrLn stderr err >> exitFailure
Right res -> evaluate $ res
Right res -> evaluate res
part <- if graphDrawPartition r
then (Just <$> stToIO (refine f encoding True))
then Just <$> stToIO (refine f encoding True)
else return Nothing
let config = DotConfig { nodeLabels = graphDrawNodeLabels r
......@@ -556,21 +550,12 @@ helpOverview argv0 =
printHelp :: Text -> Maybe HelpCommand -> IO ()
printHelp argv0 Nothing = putDoc (helpOverview argv0) >> putStrLn ""
printHelp _ (Just HelpListFunctors) =
let functors = sortBy (comparing name) (concat registeredFunctors)
let functors = sortOn name (concat registeredFunctors)
in do
T.putStrLn $ "Available functors:"
T.putStrLn "Available functors:"
putDoc (formatFunctorDescriptions functors)
-- tabularize (map (\f -> [(" - " <> name f), (syntaxExample f)]) functors)
tabularize :: [[Text]] -> IO ()
tabularize table = do
let columns = map (maximum . map T.length) (transpose table)
forM_ table $ \row -> do
forM_ (zip [0..] row) $ \(i, cell) -> do
T.putStr $ T.justifyLeft ((columns !! i) + 2) ' ' cell
T.putStr "\n"
withTimeStat :: Stats -> Text -> IO a -> IO a
withTimeStat stats name action = case statsType stats of
NoStats -> action
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment