wwffwfwf/app/Main.hs

68 lines
2.6 KiB
Haskell

-- wwffwfwf - generates truth tables from logic expressions
-- Copyright (C) 2024 VegOwOtenks
--
-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Affero General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Affero General Public License for more details.
--
-- You should have received a copy of the GNU Affero General Public License
-- along with this program. If not, see <https://www.gnu.org/licenses/>.
--
-- contact me via vegowotenks at jossco dot de
module Main (main) where
import Lib
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Either (rights, lefts)
import Data.List (intercalate)
parseInputLine :: Int -> String -> Either ParseError Expression
parseInputLine n s = parseFullString ("stdin:" ++ show n) s
title :: [String] -> String
title ns = " " ++ intercalate " # " ns
header :: [Int] -> String
header ws = intercalate "#" . map (flip replicate '#' . (+2) ) $ ws
row :: [Int] -> [Bool] -> String
row ws rs = intercalate "#" $ (zipWith row' ws rs)
where
row' :: Int -> Bool -> String
row' w b = replicate (left+1) ' ' ++ (if b then "1" else "0") ++ replicate (right+1) ' '
where
left = (w-1) `div` 2
right = (w-1) - left
main :: IO ()
main = do
equation_strings <- fmap lines getContents
let equation_expressions = zipWith parseInputLine [0..] equation_strings
-- TODO: Show proper error messages
_ <- mapM putStrLn . map show . lefts $ equation_expressions
let variable_names = Set.toAscList . Set.unions . map collectVariableNames . rights $ equation_expressions
let value_combinations = mapM (const [True, False]) [1..length variable_names]
let value_maps = map Map.fromList $ zipWith (zipWith (,)) (cycle [variable_names]) value_combinations
let expression_strings = variable_names ++ equation_strings
let column_widths = map length expression_strings
putStrLn . title $ expression_strings
putStrLn . header $ column_widths
let expressions = rights $ map (parseFullString "<internal>") variable_names ++ equation_expressions
let results = map (\m -> map (evaluate m) expressions) value_maps
mapM_ putStrLn . map (row column_widths) $ results