Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

initial code, biplate works

  • Loading branch information...
commit d09d3dc037148fb640ba0e24dfa7a55396dc6dc0 0 parents
Max Desyatov authored
4 .gitignore
@@ -0,0 +1,4 @@
+dist
+*.o
+*.hi
+*~
29 LICENSE
@@ -0,0 +1,29 @@
+Copyright (c) 2009, Max Desyatov
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above copyright
+ notice, this list of conditions and the following disclaimer in the
+ documentation and/or other materials provided with the distribution.
+
+ * Neither the name of the author nor the names of his contributors
+ may be used to endorse or promote products derived from this
+ software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
17 cabal-query.cabal
@@ -0,0 +1,17 @@
+name: cabal-query
+version: 0.0
+copyright: Max Desyatov
+category: System
+maintainer: Max Desyatov <explicitcall at gmail.com>
+author: Max Desyatov
+license: BSD3
+license-file: LICENSE
+build-depends: base >= 4, mtl, template-haskell, derive, language-c, Cabal,
+ MissingH, uniplate, bytestring, tar, DebugTraceHelpers, stream-fusion
+synopsis: cabal-query
+Stability: Experimental
+Build-type: Simple
+executable: cabal-query
+main-is: Main.hs
+ghc-options: -Wall -fno-warn-orphans -O
+hs-source-dirs: src
95 src/Main.hs
@@ -0,0 +1,95 @@
+{-# LANGUAGE TemplateHaskell #-}
+module Main where
+
+import Codec.Archive.Tar as T hiding (unpack)
+import Control.Monad hiding (join)
+import Data.ByteString.Internal (w2c)
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as B
+import Data.Data
+import Data.DeriveTH
+import Data.Generics.PlateData
+import Data.List.Stream
+import Data.List.Utils (join)
+import Distribution.Compiler
+import Distribution.License
+import Distribution.ModuleName hiding (main)
+import Distribution.Package
+import Distribution.PackageDescription
+import Distribution.PackageDescription.Parse
+import Distribution.Version
+import Language.Haskell.Extension
+import System.Environment
+
+import Prelude hiding (map, head, null, (++), filter)
+
+import TH
+
+import Debug.Trace.Helpers
+
+$(deriveMany makeTypeable
+ [''PackageDescription
+ ,''Executable
+ ,''Library
+ ,''BuildType
+ ,''VersionRange
+ ,''Dependency
+ ,''SourceRepo
+ ,''CompilerFlavor
+ ,''License
+ ,''PackageIdentifier
+ ,''BuildInfo
+ ,''ModuleName
+ ,''PackageName
+ ,''RepoType
+ ,''RepoKind
+ ,''Extension])
+
+$(deriveMany makeData
+ [''PackageDescription
+ ,''Executable
+ ,''Library
+ ,''BuildType
+ ,''VersionRange
+ ,''Dependency
+ ,''SourceRepo
+ ,''CompilerFlavor
+ ,''License
+ ,''PackageIdentifier
+ ,''BuildInfo
+ ,''PackageName
+ ,''RepoType
+ ,''RepoKind
+ ,''Extension
+ ,''Version])
+
+instance Data ModuleName where
+ gfoldl _ z = z . simple . join "." . components
+ gunfold _ z _ = z $ simple ""
+ toConstr _ = con_C
+ dataTypeOf _ = ty_T
+
+con_C :: Constr
+con_C = mkConstr ty_T "ModuleName" [] Prefix
+
+ty_T :: DataType
+ty_T = mkDataType "Distribution.ModuleName.ModuleName" [con_C]
+
+extractFields :: (Data a, Data b) => (b -> Bool) -> a -> [b]
+extractFields f l = [ x | x <- universeBi l, f x ]
+
+readIndex :: ByteString -> [PackageDescription]
+readIndex = ignoreParseErrors . map (return . packageDescription <=< parsePackageDescription) .
+ foldEntries foldF [] (const []) . T.read
+ where
+ foldF :: Entry -> [String] -> [String]
+ foldF e rest = (\(NormalFile s _) -> map w2c $ B.unpack s) (entryContent e) : rest
+
+ ignoreParseErrors :: [ParseResult a] -> [a]
+ ignoreParseErrors l = [ x | ParseOk _ x <- l ]
+
+main :: IO ()
+main = print . filter (not . null) . map (universeBi :: PackageDescription -> [License]) . readIndex =<< B.readFile . head =<< getArgs
+
+licenseAndPackageId :: (PackageIdentifier, License) -> Bool
+licenseAndPackageId (_, _) = True
8 src/TH.hs
@@ -0,0 +1,8 @@
+module TH where
+
+import Language.C.Analysis.TravMonad
+import Data.DeriveTH
+import Language.Haskell.TH
+
+deriveMany :: Derivation -> [Name] -> Q [Dec]
+deriveMany = concatMapM . derive
6 src/test.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+import Data.Data
+import Data.DeriveTH
+import Distribution.ModuleName
+
+$(derive makeData ''ModuleName)
Please sign in to comment.
Something went wrong with that request. Please try again.