Created
December 12, 2011 09:02
-
-
Save NathanHowell/1466063 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# OPTIONS_GHC -fno-warn-deprecations #-} | |
{-# OPTIONS_GHC -fno-warn-orphans #-} | |
{-# LANGUAGE OverloadedStrings #-} | |
{-# LANGUAGE RecordWildCards #-} | |
{-# LANGUAGE TemplateHaskell #-} | |
module Main (main) where | |
import Control.Monad (when) | |
import qualified Data.ByteString.Lazy as BL | |
import Data.List | |
import Data.Aeson | |
import Data.Aeson.TH | |
import qualified Data.Text as T | |
import Distribution.ModuleName (ModuleName) | |
import Distribution.Package | |
import Distribution.PackageDescription | |
import Distribution.PackageDescription.Configuration | |
import Distribution.PackageDescription.Parse (readPackageDescription) | |
import Distribution.Verbosity | |
import Distribution.Version | |
import Distribution.License | |
import Distribution.Compiler | |
import Distribution.System | |
import Distribution.Text | |
import Language.Haskell.Extension | |
import System.Environment (getArgs) | |
import System.FilePath ((</>), (<.>)) | |
import Text.PrettyPrint | |
deriveToJSON defaultOptions ''PackageDescription | |
deriveToJSON defaultOptions ''PackageIdentifier | |
deriveToJSON defaultOptions ''PackageName | |
deriveToJSON defaultOptions ''SourceRepo | |
deriveToJSON defaultOptions ''Library | |
deriveToJSON defaultOptions ''Executable | |
deriveToJSON defaultOptions ''TestSuite | |
deriveToJSON defaultOptions ''TestSuiteInterface | |
deriveToJSON defaultOptions ''BuildInfo | |
deriveToJSON defaultOptions ''Language | |
deriveToJSON defaultOptions ''Extension | |
deriveToJSON defaultOptions ''KnownExtension | |
deriveToJSON defaultOptions ''TestType | |
deriveToJSON defaultOptions ''Benchmark | |
deriveToJSON defaultOptions ''BenchmarkInterface | |
deriveToJSON defaultOptions ''BenchmarkType | |
instance ToJSON License where | |
toJSON = toJSON . render . disp | |
instance ToJSON BuildType where | |
toJSON = toJSON . render . disp | |
instance ToJSON ModuleName where | |
toJSON = toJSON . render . disp | |
instance ToJSON RepoKind where | |
toJSON = toJSON . render . disp | |
instance ToJSON RepoType where | |
toJSON = toJSON . render . disp | |
instance ToJSON Version where | |
toJSON = toJSON . render . disp | |
instance ToJSON VersionRange where | |
toJSON AnyVersion = toJSON ("any" :: T.Text) | |
toJSON (ThisVersion ver) = object ["this" .= ver] | |
toJSON (LaterVersion ver) = object ["later" .= ver] | |
toJSON (EarlierVersion ver) = object ["earlier" .= ver] | |
toJSON (WildcardVersion ver) = object ["wildcard" .= ver] | |
toJSON (UnionVersionRanges v1 v2) = object ["union" .= [v1, v2]] | |
toJSON (IntersectVersionRanges v1 v2) = object ["intersect" .= [v1, v2]] | |
toJSON (VersionRangeParens ver) = toJSON ver | |
instance ToJSON Dependency where | |
toJSON (Dependency pkg ver) = object ["package" .= pkg, "version" .= ver] | |
instance (ToJSON v, ToJSON c, ToJSON a) => ToJSON (CondTree v c a) where | |
toJSON (CondNode a c v) = object ["data" .= a, "constraints" .= c, "components" .= v] | |
instance ToJSON c => ToJSON (Condition c) where | |
toJSON (Var c) = object ["var" .= c] | |
toJSON (Lit f) = object ["lit" .= f] | |
toJSON (CNot c) = object ["not" .= c] | |
toJSON (COr c1 c2) = object ["or" .= toJSON [c1, c2]] | |
toJSON (CAnd c1 c2) = object ["and" .= toJSON [c1, c2]] | |
instance ToJSON ConfVar where | |
toJSON (OS os) = object ["os" .= os] | |
toJSON (Arch arch) = object ["arch" .= arch] | |
toJSON (Flag flag) = object ["flag" .= flag] | |
toJSON (Impl comp ver) = object ["impl" .= comp, "constraints" .= ver] | |
instance ToJSON FlagName where | |
toJSON (FlagName str) = toJSON str | |
instance ToJSON OS where | |
toJSON = toJSON . render . disp | |
instance ToJSON Arch where | |
toJSON = toJSON . render . disp | |
instance ToJSON Flag where | |
toJSON MkFlag{..} = | |
object ["name" .= flagName, "description" .= flagDescription, "default" .= flagDefault, "manual" .= flagManual] | |
instance ToJSON CompilerFlavor where | |
toJSON = toJSON . render . disp | |
data JSONDescription = JSONDescription {jsonDesc :: PackageDescription, jsonFlags :: [Flag], jsonLib :: CondTree ConfVar [Dependency] Library} | |
instance ToJSON JSONDescription where | |
toJSON JSONDescription{..} = object ["desc" .= jsonDesc, "flags" .= jsonFlags, "lib" .= jsonLib] | |
main :: IO () | |
main = do | |
args <- getArgs | |
when (length args == 0) $ fail "missing .cabal file" | |
let (source:_) = args | |
gdesc <- readPackageDescription normal source | |
let desc = flattenPackageDescription gdesc | |
case condLibrary gdesc of | |
Just lib -> do | |
let filePath = render . disp . package $ packageDescription gdesc | |
bs = encode . toJSON $ JSONDescription (packageDescription gdesc) (genPackageFlags gdesc) lib | |
BL.writeFile ("/Source/hackage/new3" </> filePath <.> "json") bs | |
-- BL.writeFile ("/dev/stdout") bs | |
Nothing -> return () |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment