1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.Aeson (eitherDecode, encode)
import Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy as LB
import Data.Maybe (fromMaybe)
import WithCli
import CheckDir (recursiveCheckDir)
import Control.Monad.Identity (Identity)
import LintConfig (LintConfig (..), patch)
import System.Exit (exitWith)
import Types (Level (..))
import Util (printPretty)
import WriteRepo (writeAdjustedRepository)
-- | the options this cli tool can take
data Options = Options
{ repository :: Maybe String
-- ^ path to the repository containing maps to lint
, entrypoint :: Maybe String
-- ^ entrypoint in that repository
, allowScripts :: Bool
-- ^ pass --allowScripts to allow javascript in map
, json :: Bool
-- ^ emit json if --json was given
, lintlevel :: Maybe Level
-- ^ maximum lint level to print
, pretty :: Bool
-- ^ pretty-print the json to make it human-readable
, out :: Maybe String
, config :: Maybe (LintConfig Maybe)
, configFile :: Maybe FilePath
} deriving (Show, Generic, HasArguments)
main :: IO ()
main = withCli run
run :: Options -> IO ()
run options = do
let repo = fromMaybe "." (repository options)
let entry = fromMaybe "main.json" (entrypoint options)
let level = fromMaybe Suggestion (lintlevel options)
print (config options)
lintconfig <- case configFile options of
Nothing -> error "Need a config file!"
Just path -> LB.readFile path >>= \res ->
case eitherDecode res :: Either String (LintConfig Identity) of
Left err -> error $ "config file invalid: " <> err
Right file -> case config options of
Just p -> pure (patch file p)
Nothing -> pure file
print lintconfig
lints <- recursiveCheckDir repo entry
if json options
then printLB
$ if pretty options then encodePretty lints else encode lints
else printPretty (level, lints)
case out options of
Just outpath -> writeAdjustedRepository repo outpath lints
>>= exitWith
Nothing -> pure ()
-- | haskell's many string types are FUN …
printLB :: LB.ByteString -> IO ()
printLB a = putStrLn $ C8.unpack $ LB.toStrict a
|
