TH.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Template Haskell splices to generate the model Input/Output
-- datatype with introspection.
module Process.Minizinc.TH where

import Process.Minizinc.Inspect
import Language.Haskell.TH
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.Text as Text


-- | Generates some Input and Ouput data types by inspecting a minizinc file.
-- Supported types are int, bools, float and their nested arrays.
genModelData :: String -> FilePath -> Q [Dec]
genModelData prefix path = do
  miface <- runIO $ inspect path
  iface <- case miface of
               Nothing -> fail "no interface" 
               Just x -> pure x
  sequence [ genFromTypeDecls prefix "Input" (_input iface)
           , genFromTypeDecls prefix "Output" (_output iface)
           ]

genFromTypeDecls :: String -> String -> TypeDeclarations -> Q Dec
genFromTypeDecls prefix base typedecls = do
  let dataname = prefix <> base
  let pairs = List.sort $ Map.assocs typedecls
  let derivations = [ DerivClause Nothing [ ConT (mkName "Show")
                                          , ConT (mkName "Eq")
                                          , ConT (mkName "Ord")
                                          , ConT (mkName "Hashable")
                                          , ConT (mkName "Generic")
                                          , ConT (mkName "ToJSON")
                                          , ConT (mkName "FromJSON")
                                          ]
                    ]
  let bang = Bang NoSourceUnpackedness NoSourceStrictness
  pure $ DataD []
     (mkName dataname)
     []
     Nothing
     [RecC (mkName dataname) [ (mkName $ Text.unpack n, bang, typeFor typedecl) | (n,typedecl) <- pairs]]
     derivations
  where
     typeFor (TypeInfo "int" False Nothing)   = ConT (mkName "Int")
     typeFor (TypeInfo "bool" False Nothing)  = ConT (mkName "Bool")
     typeFor (TypeInfo "float" False Nothing) = ConT (mkName "Float")
     typeFor (TypeInfo "int" False (Just n))  = nestedlist n $ ConT (mkName "Int")
     typeFor typedecl = error $ "unsupported type info when generating Haskell code from MiniZinc files: " <> show typedecl

     nestedlist 0 ty = ty
     nestedlist n ty = AppT ListT (nestedlist (n-1) ty)