Turn a truth table derived from command line arguments into data types

user_580042 0
Viewed 107

The real-world code my problem stems from is much more complicated than the following example (consisting of several mock functions). This example should illustrate the phenomenon my problem produces: (either) a huge table in a case/of statement (or a huge cascade of nested ifs). The case/of statement contains something similar to a truth table which decides how to parameterize the type of the result record (which is called ComposedRecord because it is a composition of three records of generic types). The mocked functions are already implemented, but I am not happy with the huge case/of block. Thus I am trying to find a more concise solution:

-- intermediate record type 1
data SimpleRecord = SimpleRecord {
  _description :: String
}

-- intermediate record type 2
data DetailedRecord = DetailedRecord {
  _title :: String,
  _details :: String
}

-- intermediate record type 3
data RawRecord = RawRecord {
  _x :: Int,
  _y :: Int,
  _z :: Int
}

class AnyRecord r where
instance AnyRecord SimpleRecord
instance AnyRecord DetailedRecord
instance AnyRecord RawRecord

-- to-be-serialized record type (composed of intermediate record types 1, 2 or 3)
data ComposedRecord a b c = ComposedRecord {
  _a :: a,
  _b :: b,
  _c :: c
}

inputToSimpleRecord :: String -> SimpleRecord
inputToSimpleRecord input = SimpleRecord {
  _description = "description derived from input"
}

inputToDetailedRecord :: String -> DetailedRecord
inputToDetailedRecord input = DetailedRecord {
  _title = "title derived from input",
  _details = "details derived from input"
}

inputToRawRecord :: String -> RawRecord
inputToRawRecord input = RawRecord {
  _x = 1, -- number derived from input string
  _y = 2, -- number derived from input string
  _z = 3  -- number derived from input string
}

serializeToJsonString :: (AnyRecord a, AnyRecord b, AnyRecord c) => ComposedRecord a b c -> String
serializeToJsonString composedRecord = "{}"
-- this function will also contain some post processing of the records
-- thus the "AnyRecord" type constraint is needed

commandLineArguments = ["simple", "detailed", "raw"]
-- the value of commandLineArguments will be read from the command line

inputFromCommandLine = "1, 2, 3" -- some input

main = do
  let result = case commandLineArguments of
        ["simple", "simple", "simple"] -> serializeToJsonString ComposedRecord {
          _a = inputToSimpleRecord inputFromCommandLine,
          _b = inputToSimpleRecord inputFromCommandLine,
          _c = inputToSimpleRecord inputFromCommandLine
        }
        ["simple", "simple", "detailed"] -> serializeToJsonString ComposedRecord {
          _a = inputToSimpleRecord inputFromCommandLine,
          _b = inputToSimpleRecord inputFromCommandLine,
          _c = inputToDetailedRecord inputFromCommandLine
        }
        ["simple", "simple", "raw"] -> serializeToJsonString ComposedRecord {
          _a = inputToSimpleRecord inputFromCommandLine,
          _b = inputToSimpleRecord inputFromCommandLine,
          _c = inputToRawRecord inputFromCommandLine
        }
        ["simple", "detailed", "simple"] -> serializeToJsonString ComposedRecord {
          _a = inputToSimpleRecord inputFromCommandLine,
          _b = inputToDetailedRecord inputFromCommandLine,
          _c = inputToSimpleRecord inputFromCommandLine
        }
        ["simple", "detailed", "detailed"] -> serializeToJsonString ComposedRecord {
          _a = inputToSimpleRecord inputFromCommandLine,
          _b = inputToDetailedRecord inputFromCommandLine,
          _c = inputToDetailedRecord inputFromCommandLine
        }
        ["simple", "detailed", "raw"] -> serializeToJsonString ComposedRecord {
          _a = inputToSimpleRecord inputFromCommandLine,
          _b = inputToDetailedRecord inputFromCommandLine,
          _c = inputToRawRecord inputFromCommandLine
        }
        ["simple", "raw", "raw"] -> serializeToJsonString ComposedRecord {
          _a = inputToSimpleRecord inputFromCommandLine,
          _b = inputToRawRecord inputFromCommandLine,
          _c = inputToRawRecord inputFromCommandLine
        }
        ["detailed", "simple", "simple"] -> serializeToJsonString ComposedRecord {
          _a = inputToDetailedRecord inputFromCommandLine,
          _b = inputToSimpleRecord inputFromCommandLine,
          _c = inputToSimpleRecord inputFromCommandLine
        }
        -- and so on...

  putStrLn result
haskell
2 Answers

To me, the key element here is the type of serializeToJsonString. That function doesn't care explicitly which Record it takes, so long as it is AnyRecord. With that in mind, you can use ExistentialQuantification to encapsulate that idea. Consider the following:

data AnyRecordData = forall r. AnyRecord r => AnyRecordData r

data ComposedRecord = ComposedRecord {
  _a :: AnyRecordData,
  _b :: AnyRecordData,
  _c :: AnyRecordData
}


inputToAnyRecord :: String -> String -> AnyRecordData
inputToAnyRecord "simple"   = AnyRecordData . inputToSimpleRecord
inputToAnyRecord "detailed" = AnyRecordData . inputToDetailedRecord
inputToAnyRecord "raw"      = AnyRecordData . inputToRawRecord

main = do
  let result = case commandLineArguments of
        [a,b,c] -> serializeToJsonString ComposedRecord {
          _a = inputToAnyRecord a inputFromCommandLine
        , _b = inputToAnyRecord b inputFromCommandLine
        , _c = inputToAnyRecord c inputFromCommandLine
        }

  putStrLn result
user_148023840

ComposedRecord is essentially a heterogeneous list type. So that's how I would approach it:

{-# LANGUAGE DataKinds #-}

import Data.HList.HList

type ComposedRecord a b c = HList '[a,b,c]

Now you can start to think recursively over this container, although with a catch because the types change during the recursion.

class CRecSerialisable r where
  serializeToJsonString :: r -> String

instance CRecSerialisable (HList '[])
instance (AnyRecord h, CRecSerialisable (HList t))
    => CRecSerialisable (HList (h ': t))
        -- ▲ at this point enable any extensions the compiler demands...

serializeToJsStr_cmdDep :: [String] -> String
serializeToJsStr_cmdDep = go HNil
 where go :: CRecSerialisable acc => acc -> [String] -> String
       go cRec [] = serializeToJsonString cRec
       go cRec ("simple" : cmdArgs)
           = go (HCons (inputToSimpleRecord inputFromCommandLine) cRec)
                 cmdArgs
       go cRec ("detailed" : cmdArgs)
           = ...
user_7459030
Related