content: -- Copyright 2015 Evan Laforge
  -- This program is distributed under the terms of the GNU General Public
  -- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt
  
  -- | This defines some key layouts.  "Local.KeyLayout" is expected to export
  -- @layout :: KeyLayouts.Layout@.  If your key layout is already qwerty, just
  -- use @KeyLayouts.qwerty@.
  --
  -- Ultimately this is necessary because some keys are mapped based on their
  -- physical location.
  module Cmd.KeyLayouts (
      Layout, layout, to_unshifted, to_shifted, from_qwerty, to_qwerty
      , qwerty, dvorak
      , qwerty_unshifted, qwerty_shifted
      , qwerty_unshifted_rows, qwerty_shifted_rows
  ) where
  import qualified Data.Map as Map
  
  import qualified Util.Maps as Maps
  import qualified Util.Lists as Lists
  
  import           Global
  
  
  data Layout = Layout {
      -- | Map from the shifted key to the unshifted one.
      map_to_unshifted :: Map Char Char
      , map_to_shifted :: Map Char Char
      -- | Map from the layout to qwerty.
      , map_from_qwerty :: Map Char Char
      , map_to_qwerty :: Map Char Char
      } deriving (Show)
  
  to_unshifted :: Layout -> Char -> Maybe Char
  to_unshifted layout c = Map.lookup c (map_to_unshifted layout)
  
  to_shifted :: Layout -> Char -> Maybe Char
  to_shifted layout c = Map.lookup c (map_to_shifted layout)
  
  from_qwerty :: Layout -> Char -> Maybe Char
  from_qwerty layout c = Map.lookup c (map_from_qwerty layout)
  
  to_qwerty :: Layout -> Char -> Maybe Char
  to_qwerty layout c = Map.lookup c (map_to_qwerty layout)
  
  layout :: String -> [Char] -> [Char] -> Layout
  layout name unshifted shifted
      | length unshifted /= length shifted =
          errorStack $ prefix <> "(unshifted, shifted) not the same length: "
              <> showt (Lists.zipPadded unshifted shifted)
      | length unshifted /= length qwerty_unshifted =
          errorStack $ prefix <> "size should be "
              <> showt (length qwerty_unshifted) <> " but is "
              <> showt (length unshifted)
      | otherwise = Layout
          { map_to_unshifted = Map.fromList $ zip shifted unshifted
          , map_to_shifted = Map.fromList $ zip unshifted shifted
          , map_from_qwerty = from_qwerty
          , map_to_qwerty = Maps.invert from_qwerty
          }
      where
      from_qwerty = Map.fromList $
          zip (qwerty_unshifted ++ qwerty_shifted) (unshifted ++ shifted)
      prefix = showt name <> ": "
  
  qwerty_unshifted, qwerty_shifted :: [Char]
  qwerty_unshifted = concat qwerty_unshifted_rows
  qwerty_shifted = concat qwerty_shifted_rows
  
  qwerty_unshifted_rows, qwerty_shifted_rows :: [[Char]]
  qwerty_unshifted_rows =
      [ "`1234567890-="
      , "qwertyuiop[]\\"
      , "asdfghjkl;'"
      , "zxcvbnm,./"
      ]
  qwerty_shifted_rows =
      [ "~!@#$%^&*()_+"
      , "QWERTYUIOP{}|"
      , "ASDFGHJKL:\""
      , "ZXCVBNM<>?"
      ]
  
  qwerty :: Layout
  qwerty = layout "qwerty" qwerty_unshifted qwerty_shifted
  
  dvorak :: Layout
  dvorak = layout "dvorak"
      (concat
          [ "`1234567890[]"
          , "',.pyfgcrl/=\\"
          , "aoeuidhtns-"
          , ";qjkxbmwvz"
          ])
      (concat
          [ "~!@#$%^&*(){}"
          , "\"<>PYFGCRL?+|"
          , "AOEUIDHTNS_"
          , ":QJKXBMWVZ"
          ])
  