cabal-dev-scripts/src/GenPathsModule.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         { zPackageName                :: PackageName
  27         , zVersionDigits              :: String
  28         , zSupportsCpp                :: Bool
  29         , zSupportsNoRebindableSyntax :: Bool
  30         , zAbsolute                   :: Bool
  31         , zRelocatable                :: Bool
  32         , zIsWindows                  :: Bool
  33         , zIsI386                     :: Bool
  34         , zIsX8664                    :: Bool
  35
  36         , zPrefix     :: FilePath
  37         , zBindir     :: FilePath
  38         , zLibdir     :: FilePath
  39         , zDynlibdir  :: FilePath
  40         , zDatadir    :: FilePath
  41         , zLibexecdir :: FilePath
  42         , zSysconfdir :: FilePath
  43
  44         , zNot                        :: Bool -> Bool
  45         , zManglePkgName              :: PackageName -> String
  46         }
  47       deriving (Generic)
  48     |])
  49
  50 -------------------------------------------------------------------------------
  51 -- Main
  52 -------------------------------------------------------------------------------
  53
  54 withIO :: (FilePath -> FilePath -> IO a) -> IO a
  55 withIO k = do
  56     args <- getArgs
  57     case args of
  58         [src,tgt] -> k src tgt `catch` \(SomeException e) -> do
  59             putStrLn $ "Exception: " ++ displayException e
  60             exitFailure
  61         _         -> do
  62             putStrLn "Usage cabal v2-run ... source.temeplate.ext target.ext"
  63             exitFailure
  64
  65 main :: IO ()
  66 main = withIO $ \src tgt -> do
  67     mdl <- parseAndCompileModuleIO config src
  68     writeFile tgt mdl
  69
  70 config :: ModuleConfig Z
  71 config = ModuleConfig
  72     { mcRender = "render"
  73     , mcHeader =
  74         [ "{-# LANGUAGE DeriveGeneric #-}"
  75         , "module Distribution.Simple.Build.PathsModule.Z (render, Z(..)) where"
  76         , "import Distribution.ZinzaPrelude"
  77         , decls
  78         , "render :: Z -> String"
  79         ]
  80     }
  81
  82 -------------------------------------------------------------------------------
  83 -- Zinza instances
  84 -------------------------------------------------------------------------------
  85
  86 instance Zinza Z where
  87     toType    = genericToTypeSFP
  88     toValue   = genericToValueSFP
  89     fromValue = genericFromValueSFP
  90
  91 -------------------------------------------------------------------------------
  92 -- Orphans
  93 -------------------------------------------------------------------------------
  94
  95 instance Zinza PackageName where
  96     toType _    = TyString (Just "prettyShow")
  97     toValue _   = error "not needed"
  98     fromValue _ = error "not needed"
  99
 100 instance Zinza Version where
 101     toType _    = TyString (Just "prettyShow")
 102     toValue _   = error "not needed"
 103     fromValue _ = error "not needed"