public
Created

Coded

  • Download Gist
Coded.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
module Main where
 
import Control.Monad
import Control.Monad.Logic
import Control.Monad.State.Strict
import qualified Data.Map as M
 
type BindingT k v = StateT (M.Map k v)
 
bind :: (Ord k, Eq v, Monad m) => k -> v -> BindingT k v m ()
bind k v = do
m <- bindings
let (mv, m') = M.insertLookupWithKey (\_ _ v -> v) k v m
case mv of
(Just v') | v /= v' -> fail $ "Cannot bind to a different value"
| otherwise -> return ()
Nothing -> put m'
 
 
bindings :: (Monad m) => BindingT k v m (M.Map k v)
bindings = get
 
runBindingT :: (Monad m) => BindingT k v m a -> m (M.Map k v)
runBindingT a = execStateT a M.empty
 
type Solver = BindingT Char Char Logic
 
main :: IO ()
main = print $ solve ["funk", "nuts", "stun"] ["6348", "8342", "8436", "2481"]
 
solve :: [String] -> [String] -> [(Char, Char)]
solve ws cs = M.toList . observe . runBindingT $ solveAll ws cs
 
solveAll :: [String] -> [String] -> Solver ()
solveAll ws cs = mapM_ (solveWord cs) ws
 
solveWord :: [String] -> String -> Solver ()
solveWord cs w = do
c <- member cs
sequence_ $ zipWith bind w c
 
member :: (MonadLogic m) => [a] -> m a
member = msum . map return

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.