{- |

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