content: {-
      Utility for generating GHCJS.Prim.Internal.Build:
  
          Helpers for constructing objects and arrays that
          can be efficiently inlined as literals.
  
      Template Haskell is not available in ghcjs-prim, therefore
      this module is generated with this external generator.
   -}
  
  module Main where
  
  import Control.Monad
  import Data.List (intercalate)
  
  sizes :: [Int]
  sizes = [1..32]
  
  moduleName = "GHCJS.Prim.Internal.Build"
  
  main :: IO ()
  main = mapM_ putStr [ genHeader, genExportList, "\n"
                      , genImports, "\n", genDefns, "\n"
                      , genImmutableA, genMutableA
                      , genImmutableO, genMutableO
                      , "\n#endif"
                      ]
  
  genHeader = unlines
    [ "-- helpers for constructing JS objects that can be efficiently inlined as literals"
    , "-- no Template Haskell available yet, generated by utils/genBuildObject.hs"
    , "{-# LANGUAGE CPP #-}"
    , "#ifndef ghcjs_HOST_OS"
    , "module " ++ moduleName ++ " () where"
    , "#else"
    , "{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, GHCForeignImportPrim #-}"
    , "module " ++ moduleName
    ]
  
  genExportList = unlines $ ("  ( "++e) : map ("  , " ++) es ++ ["  ) where"]
     where
       (e:es) = funs ++ ((\f n -> f ++ show n) <$> funs <*> sizes)
       funs   = ["buildArrayI", "buildArrayM", "buildObjectI", "buildObjectM"]
  
  genImports = unlines
    [ "import GHCJS.Prim"
    , "import GHC.Prim"
    , "import Unsafe.Coerce"
    , "import System.IO.Unsafe"
    ]
  
  genDefns = unlines
    [ "type O = JSVal -- object"
    , "type K = JSVal -- key"
    , "type V = JSVal -- value"
    , "type J = JSVal -- some JS value"
    , "type A = JSVal -- array"
    , ""
    , "seqTupList :: [(a,b)] -> [(a,b)]"
    , "seqTupList xs = go xs `seq` xs"
    , "  where go ((x1,x2):xs) = x1 `seq` x2 `seq` go xs"
    , "        go []           = ()"
    ]
  
  genImmutableA = genBuildA "unsafePerformIO (toJSArray xs)" "I" "A"
  genMutableA   = genBuildA "toJSArray xs" "M" "IO A"
  
  genImmutableO = genBuildO "I" "O"
  genMutableO   = genBuildO "M" "IO O"
  
  genBuildAL :: String -> String -> String -> String
  genBuildAL body m res = unlines $
    [ "foreign import javascript unsafe \"$r = [];\" js_emptyArray"  ++ m ++ " :: " ++ res
    , ""
    , m' ++ " :: [J] -> " ++ res
    , m' ++ " xs = " ++ body
    , "{-# INLINE [1] " ++ m' ++ " #-}"
    , "{-# RULES \"" ++ m' ++ "/empty\" " ++ m' ++ " [] = js_emptyArray" ++ m ++ " #-}"
    ] ++ map mkRule sizes
    where
      mkRule n =
        let vars = map (('x':).show) [1..n]
        in  concat [ "{-# RULES \"", m' ,"/", m', show n, "\" forall "
                   , intercalate " " vars, ". ", m'
                   , " [", intercalate "," vars, "]"
                   , " = ", m', show n, " ", intercalate " " vars, " #-}"
                   ]
      m' = "buildArray" ++ m
  
  genBuildA body n res = unlines $ genBuildAL body n res : map (genBuildA' n res) sizes
  
  genBuildA' :: String -> String -> Int -> String
  genBuildA' n res i = genBuild ("buildArray" ++ n ++ show i) imp args sig
    where
      args = intercalate " " $ map (('x':).show) [1..i]
      sig  = join (replicate i ("J -> ")) ++ res
      imp  = '[' : intercalate "," (map (('$':).show) [1..i]) ++ "]"
  
  genBuildOL :: String -> String -> String
  genBuildOL m res = unlines $
    [ "foreign import javascript unsafe \"h$buildObjectFromTupList($1)\""
    , "  js_buildObjectFromTupList" ++ m ++ " :: Any -> " ++ res
    , "foreign import javascript unsafe \"$r = {};\" js_emptyObject"  ++ m ++ " :: " ++ res
    , m' ++ " :: [(K,V)] -> " ++ res
    , m' ++ " xs = js_buildObjectFromTupList" ++ m ++ " . unsafeCoerce . seqTupList $ xs"
    , "{-# INLINE [1] " ++ m' ++ " #-}"
    , "{-# RULES \"" ++ m' ++ "/empty\" " ++ m' ++ " [] = js_emptyObject" ++ m ++ " #-}"
    ] ++ map mkRule sizes
    where
      mkRule n =
        let varst = map (\i -> let si = show i in "(k"++si++",v"++si++")") [1..n]
            vars  = concatMap (\i -> let si = show i in ['k':si,'v':si]) [1..n]
        in  concat [ "{-# RULES \"", m' ,"/", m', show n, "\" forall "
                   , intercalate " " vars, ". ", m'
                   , " [", intercalate "," varst, "]"
                   , " = ", m', show n, " ", intercalate " " vars, " #-}"
                   ]
      m' = "buildObject" ++ m
  
  genBuildO n res = unlines $ genBuildOL n res : map (genBuildO' n res) sizes
  
  genBuildO' :: String -> String -> Int -> String
  genBuildO' n res i = genBuild ("buildObject" ++ n ++ show i) imp args sig
    where
      imp  = "h$buildObject(" ++ intercalate "," (map (('$':).show) [1..2*i]) ++ ")"
      args = intercalate " " $
             map (\j -> "k" ++ show j ++ " v" ++ show j) [1..i]
      sig  = join (replicate i "K -> V -> ") ++ res
  
  genBuild n imp args sig = unlines
    [ n ++ " :: " ++ sig
    , n ++ " " ++ args ++ " ="
    , "  js_" ++ n ++ " " ++ args
    , "{-# INLINE " ++ n ++ " #-}"
    , ""
    , "foreign import javascript unsafe \"" ++ imp ++ "\""
    , "  js_" ++ n ++ " :: " ++ sig
    , ""
    ]
  
  