{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Language.Bond.Codegen.Util
( commonHeader
, commaSep
, newlineSep
, commaLineSep
, newlineSepEnd
, newlineBeginSep
, doubleLineSep
, doubleLineSepEnd
, uniqueName
, uniqueNames
, indent
, newLine
, slashForward
) where
import Data.Int (Int64)
import Data.Word
import Prelude
import Data.Text.Lazy (Text, justifyRight)
import Text.Shakespeare.Text
import Paths_bond (version)
import Data.Version (showVersion)
import Language.Bond.Util
instance ToText Word16 where
toText = toText . show
instance ToText Double where
toText = toText . show
instance ToText Integer where
toText = toText . show
indent :: Int64 -> Text
indent n = justifyRight (4 * n) ' ' ""
commaLine :: Int64 -> Text
commaLine n = [lt|,
#{indent n}|]
newLine :: Int64 -> Text
newLine n = [lt|
#{indent n}|]
doubleLine :: Int64 -> Text
doubleLine n = [lt|
#{indent n}|]
commaSep :: (a -> Text) -> [a] -> Text
commaSep = sepBy ", "
newlineSep, commaLineSep, newlineSepEnd, newlineBeginSep, doubleLineSep, doubleLineSepEnd
:: Int64 -> (a -> Text) -> [a] -> Text
newlineSep = sepBy . newLine
commaLineSep = sepBy . commaLine
newlineSepEnd = sepEndBy . newLine
newlineBeginSep = sepBeginBy . newLine
doubleLineSep = sepBy . doubleLine
doubleLineSepEnd = sepEndBy . doubleLine
commonHeader :: ToText a => a -> a -> a -> Text
commonHeader c input output = [lt|
#{c}------------------------------------------------------------------------------
#{c} This code was generated by a tool.
#{c}
#{c} Tool : Bond Compiler #{showVersion version}
#{c} Input filename: #{input}
#{c} Output filename: #{output}
#{c}
#{c} Changes to this file may cause incorrect behavior and will be lost when
#{c} the code is regenerated.
#{c} <auto-generated />
#{c}------------------------------------------------------------------------------
|]
uniqueName :: String -> [String] -> String
uniqueName baseName taken = go baseName (0::Integer)
where go name counter
| not (name `elem` taken) = name
| otherwise = go newName (counter + 1)
where newName = baseName ++ (show counter)
uniqueNames :: [String] -> [String] -> [String]
uniqueNames names reservedInit = reverse $ go names [] reservedInit
where
go [] acc _ = acc
go (name:remaining) acc reservedAcc = go remaining (newName:acc) (newName:reservedAcc)
where
newName = uniqueName name reservedAcc
slashForward :: String -> String
slashForward path = map replace path
where replace '\\' = '/'
replace c = c