content: {-# LANGUAGE CPP, RecordWildCards, ViewPatterns #-}
  
  module Generate(main) where
  
  import Control.Exception
  import Control.Monad
  import Data.Semigroup
  import Data.Char
  import Data.List
  import System.Directory
  import System.IO
  
  
  main :: IO ()
  main = do
      src <- readFile "System/FilePath/Internal.hs"
      let tests = map renderTest $ concatMap parseTest $ lines src
      writeFileBinaryChanged "tests/filepath-tests/TestGen.hs" $ unlines $
          ["-- GENERATED CODE: See ../Generate.hs"
  #ifndef GHC_MAKE
          , "{-# LANGUAGE OverloadedStrings #-}"
          , "{-# LANGUAGE ViewPatterns #-}"
  #endif
          , "{-# LANGUAGE CPP #-}"
          , "{-# OPTIONS_GHC -Wno-name-shadowing #-}"
          , "{-# OPTIONS_GHC -Wno-orphans #-}"
          ,"module TestGen(tests) where"
          ,"import TestUtil"
          ,"#if !MIN_VERSION_base(4,11,0)"
          ,"import Data.Semigroup"
          ,"#endif"
          ,"import Prelude as P"
          ,"import Data.String"
          ,"import GHC.IO.Encoding.Failure ( CodingFailureMode(..) )"
          ,"import GHC.IO.Encoding.UTF16 ( mkUTF16le )"
          ,"import GHC.IO.Encoding.UTF8 ( mkUTF8 )"
          ,"import System.OsString.Internal.Types"
          ,"import System.OsString.Encoding.Internal"
          ,"import qualified Data.Char as C"
          ,"import qualified System.OsString.Data.ByteString.Short as SBS"
          ,"import qualified System.OsString.Data.ByteString.Short.Word16 as SBS16"
          ,"import qualified System.FilePath.Windows as W"
          ,"import qualified System.FilePath.Posix as P"
  #ifdef GHC_MAKE
          ,"import qualified System.OsPath.Windows.Internal as AFP_W"
          ,"import qualified System.OsPath.Posix.Internal as AFP_P"
  #else
          ,"import qualified System.OsPath.Windows as AFP_W"
          ,"import qualified System.OsPath.Posix as AFP_P"
  #endif
          ,"instance IsString WindowsString where fromString = WS . either (error . show) id . encodeWithTE (mkUTF16le TransliterateCodingFailure)"
          ,"instance IsString PosixString where fromString = PS . either (error . show) id . encodeWithTE (mkUTF8 TransliterateCodingFailure)"
          ,"#if defined(mingw32_HOST_OS) || defined(__MINGW32__)"
          ,"instance IsString OsString where fromString = OsString . WS . either (error . show) id . encodeWithTE (mkUTF16le TransliterateCodingFailure)"
          ,"#else"
          ,"instance IsString OsString where fromString = OsString . PS . either (error . show) id . encodeWithTE (mkUTF8 TransliterateCodingFailure)"
          ,"#endif"
          ,"tests :: [(String, Property)]"
          ,"tests ="] ++
          ["    " ++ c ++ "(" ++ show t1 ++ ", " ++ t2 ++ ")" | (c,(t1,t2)) <- zip ("[":repeat ",") tests] ++
          ["    ]"]
  
  
  
  data PW = P      -- legacy posix
          | W      -- legacy windows
          | AFP_P  -- abstract-filepath posix
          | AFP_W  -- abstract-filepath windows
    deriving Show
  
  data Test = Test
      {testPlatform :: PW
      ,testVars :: [(String,String)]   -- generator constructor, variable
      ,testBody :: [String]
      }
  
  
  parseTest :: String -> [Test]
  parseTest (stripPrefix "-- > " -> Just x) = platform $ toLexemes x
      where
          platform ("Windows":":":x) = [valid W x, valid AFP_W x]
          platform ("Posix"  :":":x) = [valid P x, valid AFP_P x]
          platform x                 = [valid P x, valid W x, valid AFP_P x, valid AFP_W x]
  
          valid p ("Valid":x) = free p a $ drop 1 b
              where (a,b) = break (== "=>") x
          valid p x = free p [] x
  
          free p val x = Test p [(ctor v, v) | v <- vars] x
              where vars = nub $ sort [v | v@[c] <- x, isAlpha c]
                    ctor v | v < "x"  = ""
                           | v `elem` val = "QFilePathValid" ++ show p
                           | otherwise = case p of
                                           AFP_P -> if v == "z" then "QFilePathsAFP_P" else "QFilePathAFP_P"
                                           AFP_W -> if v == "z" then "QFilePathsAFP_W" else "QFilePathAFP_W"
                                           _ -> if v == "z" then "" else "QFilePath"
  parseTest _ = []
  
  
  toLexemes :: String -> [String]
  toLexemes x = case lex x of
      [("","")] -> []
      [(x,y)] -> x : toLexemes y
      y -> error $ "Generate.toLexemes, " ++ show x ++ " -> " ++ show y
  
  
  fromLexemes :: [String] -> String
  fromLexemes = unwords . f
      where
          f ("`":x:"`":xs) = ("`" ++ x ++ "`") : f xs
          f (x:y:xs) | x `elem` ["[","("] || y `elem` [",",")","]"] = f $ (x ++ y) : xs
          f (x:xs) = x : f xs
          f [] = []
  
  
  renderTest :: Test -> (String, String)
  renderTest Test{..} = (body, code)
      where
          code = "property $ " ++ if null testVars then body else "\\" ++ unwords vars ++ " -> " ++ body
          vars = [if null ctor then v else "(" ++ ctor ++ " " ++ v ++ ")" | (ctor,v) <- testVars]
  
          body = fromLexemes $ map (qualify testPlatform) testBody
  
  
  
  qualify :: PW -> String -> String
  qualify pw str
      | str `elem` fpops || (all isAlpha str && length str > 1 && str `notElem` prelude)
        = if str `elem` bs then qualifyBS str  else show pw ++ "." ++ str
      | otherwise = encode str
      where
          bs = ["null", "concat", "isPrefixOf", "isSuffixOf", "any"]
          prelude = ["elem","uncurry","snd","fst","not","if","then","else"
                    ,"True","False","Just","Nothing","fromJust","foldr"]
          fpops = ["</>","<.>","-<.>"]
  #ifdef GHC_MAKE
          encode v
            | isString' v = case pw of
                              AFP_P -> "(encodeUtf8 " <> v <> ")"
                              AFP_W -> "(encodeUtf16LE " <> v <> ")"
                              _ -> v
            | isChar' v = case pw of
                              AFP_P -> "(fromIntegral . C.ord $ " <> v <> ")"
                              AFP_W -> "(fromIntegral . C.ord $ " <> v <> ")"
                              _ -> v
            | otherwise = v
          isString' xs@('"':_:_) = last xs == '"'
          isString' _ = False
          isChar' xs@('\'':_:_) = last xs == '\''
          isChar' _ = False
          qualifyBS v = case pw of
                          AFP_P -> "SBS." <> v
                          AFP_W -> "SBS16." <> v
                          _ -> v
  #else
          encode v
            | isString' v = case pw of
                              AFP_P -> "(" <> v <> ")"
                              AFP_W -> "(" <> v <> ")"
                              _ -> v
            | isChar' v = case pw of
                              AFP_P -> "(PW . fromIntegral . C.ord $ " <> v <> ")"
                              AFP_W -> "(WW . fromIntegral . C.ord $ " <> v <> ")"
                              _ -> v
            | otherwise = v
          isString' xs@('"':_:_) = last xs == '"'
          isString' _ = False
          isChar' xs@('\'':_:_) = last xs == '\''
          isChar' _ = False
          qualifyBS v = case pw of
                          AFP_P
                            | v == "concat" -> "(PS . SBS." <> v <> " . fmap getPosixString)"
                            | v == "any" -> "(\\f (getPosixString -> x) -> SBS." <> v <> " (f . PW) x)"
                            | v == "isPrefixOf" -> "(\\(getPosixString -> x) (getPosixString -> y) -> SBS." <> v <> " x y)"
                            | v == "isSuffixOf" -> "(\\(getPosixString -> x) (getPosixString -> y) -> SBS." <> v <> " x y)"
                            | otherwise -> "(SBS." <> v <> " . getPosixString)"
                          AFP_W
                            | v == "concat" -> "(WS . SBS16." <> v <> " . fmap getWindowsString)"
                            | v == "any" -> "(\\f (getWindowsString -> x) -> SBS16." <> v <> " (f . WW) x)"
                            | v == "isPrefixOf" -> "(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16." <> v <> " x y)"
                            | v == "isSuffixOf" -> "(\\(getWindowsString -> x) (getWindowsString -> y) -> SBS16." <> v <> " x y)"
                            | otherwise -> "(SBS16." <> v <> " . getWindowsString)"
                          _ -> v
  #endif
  
  
  
  ---------------------------------------------------------------------
  -- UTILITIES
  
  writeFileBinary :: FilePath -> String -> IO ()
  writeFileBinary file x = withBinaryFile file WriteMode $ \h -> hPutStr h x
  
  readFileBinary' :: FilePath -> IO String
  readFileBinary' file = withBinaryFile file ReadMode $ \h -> do
      s <- hGetContents h
      evaluate $ length s
      pure s
  
  writeFileBinaryChanged :: FilePath -> String -> IO ()
  writeFileBinaryChanged file x = do
      b <- doesFileExist file
      old <- if b then fmap Just $ readFileBinary' file else pure Nothing
      when (Just x /= old) $
          writeFileBinary file x
  