content: {- |
  Module      :  ./Framework/WriteLogicUtils.hs
  Description :  Utility functions for writing object logic instances
  Copyright   :  (c) Kristina Sojakova, DFKI Bremen 2010
  License     :  GPLv2 or higher, see LICENSE.txt
  
  Maintainer  :  k.sojakova@jacobs-university.de
  Stability   :  experimental
  Portability :  portable
  -}
  
  module Framework.WriteLogicUtils where
  
  import Data.List
  
  tab :: String
  tab = "    "
  
  multiOpt :: String
  multiOpt = "MultiParamTypeClasses"
  
  synOpt :: String
  synOpt = "TypeSynonymInstances"
  
  prefixBy :: String -> [String] -> [String]
  prefixBy s = map (s ++)
  
  sepHoriz :: [String] -> String
  sepHoriz = concat . prefixBy " "
  
  sepTabVert :: [String] -> String
  sepTabVert = concat . prefixBy ('\n' : tab)
  
  mkCompOpt :: [String] -> String
  mkCompOpt opts = "{-# LANGUAGE " ++ intercalate ", " opts ++ " #-}"
  
  mkModDecl :: String -> String
  mkModDecl n = "module " ++ n ++ " where"
  
  mkImports :: [String] -> String
  mkImports imps =
    intercalate "\n" $ prefixBy "import " imps
  
  mkLid :: String -> String
  mkLid lid = "data " ++ lid ++ " = " ++ lid ++ " deriving Show"
  
  mkImpl :: String -> String -> String -> String
  mkImpl f lid imp =
    f ++ " " ++ lid ++ " = " ++ imp
  
  inheritImpl :: String -> String -> String -> String
  inheritImpl s l ml = mkImpl s l $ s ++ " " ++ ml
  
  mkInst :: String -> String -> [String] -> [String] -> String
  mkInst inst lid args impls =
    let header = "instance " ++ inst ++ " " ++ lid
        argL = length args > 1
        impE = not $ null impls
        in header ++
           if argL && impE then
              sepTabVert $ args ++ ["where"] ++ impls else
              if argL then
                 sepTabVert args else
                 if impE then
                    sepHoriz args ++ " where" ++ sepTabVert impls else
                    sepHoriz args
  
  mkDecl :: String -> String -> String -> String
  mkDecl n t v = n ++ " :: " ++ t ++ "\n" ++ n ++ " = " ++ v
  