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 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         [ "{- FOURMOLU_DISABLE -}"
  75         , "{-# LANGUAGE DeriveGeneric #-}"
  76         , "module Distribution.Simple.Build.PathsModule.Z (render, Z(..)) where"
  77         , "import Distribution.ZinzaPrelude"
  78         , decls
  79         , "render :: Z -> String"
  80         ]
  81     }
  82
  83 -------------------------------------------------------------------------------
  84 -- Zinza instances
  85 -------------------------------------------------------------------------------
  86
  87 instance Zinza Z where
  88     toType    = genericToTypeSFP
  89     toValue   = genericToValueSFP
  90     fromValue = genericFromValueSFP
  91
  92 -------------------------------------------------------------------------------
  93 -- Orphans
  94 -------------------------------------------------------------------------------
  95
  96 instance Zinza PackageName where
  97     toType _    = TyString (Just "prettyShow")
  98     toValue _   = error "not needed"
  99     fromValue _ = error "not needed"
 100
 101 instance Zinza Version where
 102     toType _    = TyString (Just "prettyShow")
 103     toValue _   = error "not needed"
 104     fromValue _ = error "not needed"