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 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         [ "{- FOURMOLU_DISABLE -}"
  81         , "{-# LANGUAGE DeriveGeneric #-}"
  82         , "module Distribution.Simple.Build.Macros.Z (render, Z(..), ZPackage (..), ZTool (..)) where"
  83         , "import Distribution.ZinzaPrelude"
  84         , decls
  85         , "render :: Z -> String"
  86         ]
  87     }
  88
  89 -------------------------------------------------------------------------------
  90 -- Zinza instances
  91 -------------------------------------------------------------------------------
  92
  93 instance Zinza Z where
  94     toType    = genericToTypeSFP
  95     toValue   = genericToValueSFP
  96     fromValue = genericFromValueSFP
  97
  98 instance Zinza ZPackage where
  99     toType    = genericToTypeSFP
 100     toValue   = genericToValueSFP
 101     fromValue = genericFromValueSFP
 102
 103 instance Zinza ZTool where
 104     toType    = genericToTypeSFP
 105     toValue   = genericToValueSFP
 106     fromValue = genericFromValueSFP
 107
 108 -------------------------------------------------------------------------------
 109 -- Orphans
 110 -------------------------------------------------------------------------------
 111
 112 instance Zinza PackageName where
 113     toType _    = TyString (Just "prettyShow")
 114     toValue _   = error "not needed"
 115     fromValue _ = error "not needed"
 116
 117 instance Zinza Version where
 118     toType _    = TyString (Just "prettyShow")
 119     toValue _   = error "not needed"
 120     fromValue _ = error "not needed"