cabal-dev-scripts/src/GenCabalMacros.hs

   1 {-# LANGUAGE DeriveGeneric       #-}
   2 {-# LANGUAGE GADTs               #-}
   3 {-# LANGUAGE ScopedTypeVariables #-}
   4 {-# LANGUAGE TemplateHaskell     #-}
   5 {-# OPTIONS_GHC -Wno-orphans #-}
   6 module Main (main) where
   7
   8 import Control.Exception              (SomeException (..), catch, displayException)
   9 import Distribution.Types.PackageName (PackageName)
  10 import Distribution.Types.Version     (Version)
  11 import GHC.Generics                   (Generic)
  12 import System.Environment             (getArgs)
  13 import System.Exit                    (exitFailure)
  14 import Zinza
  15        (ModuleConfig (..), Ty (..), Zinza (..), genericFromValueSFP, genericToTypeSFP,
  16        genericToValueSFP, parseAndCompileModuleIO)
  17
  18 import Capture
  19
  20 -------------------------------------------------------------------------------
  21 -- Inputs
  22 -------------------------------------------------------------------------------
  23
  24 $(capture "decls" [d|
  25     data Z = Z
  26         { zPackages        :: [ZPackage]
  27         , zTools           :: [ZTool]
  28         , zPackageKey      :: String
  29         , zComponentId     :: String
  30         , zPackageVersion  :: Version
  31         , zNotNull         :: String -> Bool
  32         , zManglePkgName   :: PackageName -> String
  33         , zMangleStr       :: String -> String
  34         }
  35       deriving (Generic)
  36
  37     data ZPackage = ZPackage
  38         { zpkgName    :: PackageName
  39         , zpkgVersion :: Version
  40         , zpkgX       :: String
  41         , zpkgY       :: String
  42         , zpkgZ       :: String
  43         }
  44       deriving (Generic)
  45
  46     data ZTool = ZTool
  47         { ztoolName    :: String
  48         , ztoolVersion :: Version
  49         , ztoolX       :: String
  50         , ztoolY       :: String
  51         , ztoolZ       :: String
  52         }
  53       deriving (Generic)
  54     |])
  55
  56 -------------------------------------------------------------------------------
  57 -- Main
  58 -------------------------------------------------------------------------------
  59
  60 withIO :: (FilePath -> FilePath -> IO a) -> IO a
  61 withIO k = do
  62     args <- getArgs
  63     case args of
  64         [src,tgt] -> k src tgt `catch` \(SomeException e) -> do
  65             putStrLn $ "Exception: " ++ displayException e
  66             exitFailure
  67         _         -> do
  68             putStrLn "Usage cabal v2-run ... source.temeplate.ext target.ext"
  69             exitFailure
  70
  71 main :: IO ()
  72 main = withIO $ \src tgt -> do
  73     mdl <- parseAndCompileModuleIO config src
  74     writeFile tgt mdl
  75
  76 config :: ModuleConfig Z
  77 config = ModuleConfig
  78     { mcRender = "render"
  79     , mcHeader =
  80         [ "{-# LANGUAGE DeriveGeneric #-}"
  81         , "module Distribution.Simple.Build.Macros.Z (render, Z(..), ZPackage (..), ZTool (..)) where"
  82         , "import Distribution.ZinzaPrelude"
  83         , decls
  84         , "render :: Z -> String"
  85         ]
  86     }
  87
  88 -------------------------------------------------------------------------------
  89 -- Zinza instances
  90 -------------------------------------------------------------------------------
  91
  92 instance Zinza Z where
  93     toType    = genericToTypeSFP
  94     toValue   = genericToValueSFP
  95     fromValue = genericFromValueSFP
  96
  97 instance Zinza ZPackage where
  98     toType    = genericToTypeSFP
  99     toValue   = genericToValueSFP
 100     fromValue = genericFromValueSFP
 101
 102 instance Zinza ZTool where
 103     toType    = genericToTypeSFP
 104     toValue   = genericToValueSFP
 105     fromValue = genericFromValueSFP
 106
 107 -------------------------------------------------------------------------------
 108 -- Orphans
 109 -------------------------------------------------------------------------------
 110
 111 instance Zinza PackageName where
 112     toType _    = TyString (Just "prettyShow")
 113     toValue _   = error "not needed"
 114     fromValue _ = error "not needed"
 115
 116 instance Zinza Version where
 117     toType _    = TyString (Just "prettyShow")
 118     toValue _   = error "not needed"
 119     fromValue _ = error "not needed"