11{-# LANGUAGE BlockArguments #-}
22{-# LANGUAGE DataKinds #-}
3+ {-# LANGUAGE DeriveAnyClass #-}
4+ {-# LANGUAGE DerivingStrategies #-}
35{-# LANGUAGE LambdaCase #-}
46{-# LANGUAGE OverloadedStrings #-}
57{-# LANGUAGE RecordWildCards #-}
8+ {-# OPTIONS_GHC -Wno-orphans #-}
69
710module Main (main ) where
811
912import Control.Exception
1013import Control.Monad
14+ import Data.Aeson qualified as A
1115import Data.Binary qualified as Binary
16+ import Data.Binary.Get qualified as Binary
1217import Data.Binary.Put qualified as Binary
1318import Data.ByteString qualified as ByteString
1419import Data.ByteString.Lazy qualified as BL
@@ -21,7 +26,9 @@ import Data.Text.Encoding (decodeLatin1)
2126import Data.Text.Encoding.Error (UnicodeException )
2227import Data.Text.IO.Utf8 qualified as T.Utf8
2328import Distribution.ModuleName (ModuleName )
29+ import Distribution.ModuleName qualified as ModuleName
2430import Distribution.Types.PackageName (PackageName )
31+ import Distribution.Types.PackageName qualified as PackageName
2532import Formatting
2633import Hoogle qualified
2734import Options.Applicative
@@ -175,18 +182,54 @@ displayFixityStats packages =
175182 declarationsPerModule = concatMap Map. elems modulesPerPackage
176183 declarationCount = sum (Map. size <$> declarationsPerModule)
177184
178- data Config = Config
179- { cfgHoogleDatabasePath :: FilePath ,
180- cfgOutputPath :: FilePath
181- }
185+ -- ToJSON orphan instances
186+
187+ deriving anyclass instance A. ToJSON FixityInfo
188+
189+ deriving anyclass instance A. ToJSON FixityDirection
190+
191+ instance A. ToJSON OpName where
192+ toJSON = A. toJSON . unOpName
193+
194+ deriving anyclass instance A. ToJSONKey OpName
195+
196+ instance A. ToJSON ModuleName where
197+ toJSON = A. toJSON . ModuleName. toFilePath
198+
199+ deriving anyclass instance A. ToJSONKey ModuleName
200+
201+ instance A. ToJSON PackageName where
202+ toJSON = A. toJSON . PackageName. unPackageName
203+
204+ deriving anyclass instance A. ToJSONKey PackageName
205+
206+ -- CLI config
207+
208+ data Config
209+ = Generate
210+ { cfgHoogleDatabasePath :: FilePath ,
211+ cfgOutputPath :: FilePath
212+ }
213+ | Dump
214+ { cfgPath :: FilePath
215+ }
182216 deriving (Eq , Show )
183217
184218configParserInfo :: ParserInfo Config
185219configParserInfo = info (helper <*> configParser) fullDesc
186220 where
187221 configParser :: Parser Config
188222 configParser =
189- Config
223+ subparser . mconcat $
224+ [ command " generate" . info (helper <*> generateParser) $
225+ fullDesc <> progDesc " Generate a Hackage info database." ,
226+ command " dump" . info (helper <*> dumpParser) $
227+ fullDesc <> progDesc " Dump a generated Hackage info database to JSON."
228+ ]
229+
230+ generateParser :: Parser Config
231+ generateParser =
232+ Generate
190233 <$> (strArgument . mconcat )
191234 [ metavar " HOOGLE_DATABASE_PATH" ,
192235 help
@@ -201,9 +244,22 @@ configParserInfo = info (helper <*> configParser) fullDesc
201244 value defaultOutputPath
202245 ]
203246
247+ dumpParser :: Parser Config
248+ dumpParser =
249+ Dump
250+ <$> (strArgument . mconcat )
251+ [ metavar " HACKAGE_INFO_PATH" ,
252+ help " A generated Hackage info database"
253+ ]
254+
204255main :: IO ()
205- main = do
206- Config {.. } <- execParser configParserInfo
207- hackageInfo' <- extractHoogleInfo cfgHoogleDatabasePath
208- BL. writeFile cfgOutputPath . Binary. runPut . Binary. put $
209- HackageInfo hackageInfo'
256+ main =
257+ execParser configParserInfo >>= \ case
258+ Generate {.. } -> do
259+ hackageInfo' <- extractHoogleInfo cfgHoogleDatabasePath
260+ BL. writeFile cfgOutputPath . Binary. runPut . Binary. put $
261+ HackageInfo hackageInfo'
262+ Dump {.. } -> do
263+ HackageInfo hackageInfo' <-
264+ Binary. runGet Binary. get <$> BL. readFile cfgPath
265+ BL. putStr $ A. encode hackageInfo'
0 commit comments