from-1.0.0.0: test/Main.hs

{-# LANGUAGE OverloadedStrings #-}

module Main (main) where

import Control.Exception
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as B
import RawFilePath
import System.Exit
import System.IO
import System.Posix.Env.ByteString
import System.Posix.Temp.ByteString

srcTypes :: [ByteString]
srcTypes =
  [ "Int"
  , "Integer"
  , "Int8"
  , "Int16"
  , "Int32"
  , "Int64"
  , "Word8"
  , "Word16"
  , "Word32"
  , "Word64"
  ]

dstTypes :: [ByteString]
dstTypes =
  [ "Int"
  , "Integer"
  , "Int8"
  , "Int16"
  , "Int32"
  , "Int64"
  , "Word8"
  , "Word16"
  , "Word32"
  , "Word64"
  , "Float"
  , "Double"
  ]

main :: IO ()
main = do
  args <- getArgs
  let shouldKeepFile = "--keep" `elem` args
  bracket acquire (release shouldKeepFile) $ \(tmpPath, hdl) -> do
    B.putStr $ tmpPath <> "\n"
    B.hPutBuilder hdl $ header <> mconcat instancePart
    hClose hdl
    diffExitCode <-
      runProcess "diff" ["-u", "--color=always", tmpPath, "src/From/Num.hs"]
    case diffExitCode of
      ExitSuccess -> return ()
      _ -> exitWith diffExitCode
 where
  acquire = mkstemps "haskell-from-" ".hs"
  release shouldKeepFile (path, hdl)
    | shouldKeepFile = hClose hdl
    | otherwise = hClose hdl >> removeFile path

  runProcess cmd args = startProcess (proc cmd args) >>= waitForProcess

  instanceLine src dst =
    mconcat ["instance From ", B.byteString src, " ", B.byteString dst, " where\n"]
  instancePart =
    [ mconcat
        [ "\n"
        , "-- | Implementation is 'fromIntegral'\n"
        , instanceLine src dst
        , "  from = fromIntegral\n"
        ]
    | src <- srcTypes
    , dst <- dstTypes
    , src /= dst
    ]

header :: Builder
header =
  "{-# LANGUAGE MultiParamTypeClasses #-}\n\
  \{-# OPTIONS_GHC -Wno-orphans #-}\n\
  \\n\
  \module From.Num () where\n\
  \\n\
  \import Data.Int\n\
  \import Data.Word\n\
  \import From.Classes\n"