Moore automat implementation.

Solver.hs

{-# LANGUAGE ExistentialQuantification, LambdaCase #-}
{-# LANGUAGE FlexibleInstances, OverlappingInstances #-}
--{-# LANGUAGE TemplateHaskell #-}
 
-- | Main entry point to the application.
module Main where
 
--import Data.List (permutations)
import Control.Monad ( replicateM )
import Data.Data ( dataTypeConstrs
                 , dataTypeOf
                 )
import qualified Data.Map as Map
--import Data.Constraint.Forall
--import Language.Haskell.TH
import Control.Applicative ( (<$>)
                           , (<*>)
                           )

{- ARITY -} 

--| See: <http://stackoverflow.com/a/26074591>
 
class Arity f where
  arity :: f -> Int
 
instance Arity x where
  arity _ = 0
 
instance Arity f => Arity ((->) a f) where
  arity f = 1 + arity (f undefined) 

--| Moore automat
 
data CheckBox = CheckBox { a :: Bool
                         , b :: Bool
                         , c :: Bool
                         }
-- todo: write enabler and disabler for checkbox with arbitrary items count
checkBoxON  = CheckBox { a = True,  b = True,  c = True } -- todo: use 'arity' func and curring
checkBoxOFF = CheckBox { a = False, b = False, c = False } -- todo: use 'arity' func and curring

-- todo: replace CheckBox with abstract type
solver :: forall a. CheckBox -> Maybe a
solevr = flip lookup $ Map.fromList solve
  where
    solve = zip conditions solutions
    conditions = replicateM count [True, False] -- todo: replace hardcode '[True. False]' by dynamic getting constructors from 'Bool'
    count = arity CheckBox
    solutions = [fun1, fun2, fun3, fun4, fun5, fun6, fun7, fun8]
      where
        fun1 = undefined
        fun2 = undefined
        fun3 = undefined
        fun4 = undefined
        fun5 = undefined
        fun6 = undefined
        fun7 = undefined
        fun8 = undefined

main = do
    putStrLn . show . tiny_solver $ checkBoxON { b = False }

Solver_new.hs

{-# LANGUAGE ExistentialQuantification, LambdaCase #-}
{-# LANGUAGE FlexibleInstances, OverlappingInstances #-}
--{-# LANGUAGE TemplateHaskell #-}
 
-- | Main entry point to the application.
module Main where
 
--import Data.List (permutations)
import Control.Monad ( replicateM )
import Data.Data ( dataTypeConstrs
                 , dataTypeOf
                 )
import qualified Data.Map as Map
--import Data.Constraint.Forall
--import Language.Haskell.TH
import Control.Applicative ( (<$>)
                           , (<*>)
                           )

{- Moore automat -}

newtype CheckBox = CheckBox { fromCheckBox :: [Bool] }
                   deriving  ( Eq
                             , Show
                             , Read
                             )

checkBoxON  :: Int -> CheckBox
checkBoxON n = CheckBox $ replicate n True

checkBoxOFF  :: Int -> CheckBox
checkBoxOFF n = CheckBox $ replicate n False

-- todo: rewrite constant list function to carring return value
solver  :: forall a. CheckBox -> Maybe a
solver b = lookup b solve
  where
    solve = zip conditions solutions
    conditions = map CheckBox $ replicateM count constructors
      where
        constructors = read . show . dataTypeConstrs . dataTypeOf $ fromCheckBox b
        count = length $ fromCheckBox b
    solutions = [fun1, fun2, fun3, fun4, fun5, fun6, fun7, fun8]
      where
        fun1 = 1
        fun2 = 2
        fun3 = 3
        fun4 = 4
        fun5 = 5
        fun6 = 6
        fun7 = 7
        fun8 = 8

main = putStrLn $ result . solver $ checkBoxON 3
  where
    result (Just s) = "Result" ++ (show s)
    result Nothing  = "Something goes wrong: there's no solutions for your checkboxies!"