{- |
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 :: String
tab = "    "

multiOpt :: String
multiOpt :: String
multiOpt = "MultiParamTypeClasses"

synOpt :: String
synOpt :: String
synOpt = "TypeSynonymInstances"

prefixBy :: String -> [String] -> [String]
prefixBy :: String -> [String] -> [String]
prefixBy s :: String
s = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++)

sepHoriz :: [String] -> String
sepHoriz :: [String] -> String
sepHoriz = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
prefixBy " "

sepTabVert :: [String] -> String
sepTabVert :: [String] -> String
sepTabVert = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
prefixBy ('\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
tab)

mkCompOpt :: [String] -> String
mkCompOpt :: [String] -> String
mkCompOpt opts :: [String]
opts = "{-# LANGUAGE " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " [String]
opts String -> String -> String
forall a. [a] -> [a] -> [a]
++ " #-}"

mkModDecl :: String -> String
mkModDecl :: String -> String
mkModDecl n :: String
n = "module " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ " where"

mkImports :: [String] -> String
mkImports :: [String] -> String
mkImports imps :: [String]
imps =
  String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
prefixBy "import " [String]
imps

mkLid :: String -> String
mkLid :: String -> String
mkLid lid :: String
lid = "data " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lid String -> String -> String
forall a. [a] -> [a] -> [a]
++ " = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lid String -> String -> String
forall a. [a] -> [a] -> [a]
++ " deriving Show"

mkImpl :: String -> String -> String -> String
mkImpl :: String -> String -> String -> String
mkImpl f :: String
f lid :: String
lid imp :: String
imp =
  String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lid String -> String -> String
forall a. [a] -> [a] -> [a]
++ " = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
imp

inheritImpl :: String -> String -> String -> String
inheritImpl :: String -> String -> String -> String
inheritImpl s :: String
s l :: String
l ml :: String
ml = String -> String -> String -> String
mkImpl String
s String
l (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ml

mkInst :: String -> String -> [String] -> [String] -> String
mkInst :: String -> String -> [String] -> [String] -> String
mkInst inst :: String
inst lid :: String
lid args :: [String]
args impls :: [String]
impls =
  let header :: String
header = "instance " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
inst String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
lid
      argL :: Bool
argL = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1
      impE :: Bool
impE = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
impls
      in String
header String -> String -> String
forall a. [a] -> [a] -> [a]
++
         if Bool
argL Bool -> Bool -> Bool
&& Bool
impE then
            [String] -> String
sepTabVert ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["where"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
impls else
            if Bool
argL then
               [String] -> String
sepTabVert [String]
args else
               if Bool
impE then
                  [String] -> String
sepHoriz [String]
args String -> String -> String
forall a. [a] -> [a] -> [a]
++ " where" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [String] -> String
sepTabVert [String]
impls else
                  [String] -> String
sepHoriz [String]
args

mkDecl :: String -> String -> String -> String
mkDecl :: String -> String -> String -> String
mkDecl n :: String
n t :: String
t v :: String
v = String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ " :: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ " = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
v