-- 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.
    Layout -> Map Char Char
map_to_unshifted :: Map Char Char
    , Layout -> Map Char Char
map_to_shifted :: Map Char Char
    -- | Map from the layout to qwerty.
    , Layout -> Map Char Char
map_from_qwerty :: Map Char Char
    , Layout -> Map Char Char
map_to_qwerty :: Map Char Char
    } deriving (Int -> Layout -> ShowS
[Layout] -> ShowS
Layout -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Layout] -> ShowS
$cshowList :: [Layout] -> ShowS
show :: Layout -> [Char]
$cshow :: Layout -> [Char]
showsPrec :: Int -> Layout -> ShowS
$cshowsPrec :: Int -> Layout -> ShowS
Show)

to_unshifted :: Layout -> Char -> Maybe Char
to_unshifted :: Layout -> Char -> Maybe Char
to_unshifted Layout
layout Char
c = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
c (Layout -> Map Char Char
map_to_unshifted Layout
layout)

to_shifted :: Layout -> Char -> Maybe Char
to_shifted :: Layout -> Char -> Maybe Char
to_shifted Layout
layout Char
c = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
c (Layout -> Map Char Char
map_to_shifted Layout
layout)

from_qwerty :: Layout -> Char -> Maybe Char
from_qwerty :: Layout -> Char -> Maybe Char
from_qwerty Layout
layout Char
c = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
c (Layout -> Map Char Char
map_from_qwerty Layout
layout)

to_qwerty :: Layout -> Char -> Maybe Char
to_qwerty :: Layout -> Char -> Maybe Char
to_qwerty Layout
layout Char
c = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Char
c (Layout -> Map Char Char
map_to_qwerty Layout
layout)

layout :: String -> [Char] -> [Char] -> Layout
layout :: [Char] -> [Char] -> [Char] -> Layout
layout [Char]
name [Char]
unshifted [Char]
shifted
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
unshifted forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
shifted =
        forall a. Stack => Text -> a
errorStack forall a b. (a -> b) -> a -> b
$ Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
"(unshifted, shifted) not the same length: "
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (forall a b. [a] -> [b] -> [Paired a b]
Lists.zipPadded [Char]
unshifted [Char]
shifted)
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
unshifted forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
qwerty_unshifted =
        forall a. Stack => Text -> a
errorStack forall a b. (a -> b) -> a -> b
$ Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
"size should be "
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
qwerty_unshifted) forall a. Semigroup a => a -> a -> a
<> Text
" but is "
            forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
unshifted)
    | Bool
otherwise = Layout
        { map_to_unshifted :: Map Char Char
map_to_unshifted = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Char]
shifted [Char]
unshifted
        , map_to_shifted :: Map Char Char
map_to_shifted = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Char]
unshifted [Char]
shifted
        , map_from_qwerty :: Map Char Char
map_from_qwerty = Map Char Char
from_qwerty
        , map_to_qwerty :: Map Char Char
map_to_qwerty = forall a k. Ord a => Map k a -> Map a k
Maps.invert Map Char Char
from_qwerty
        }
    where
    from_qwerty :: Map Char Char
from_qwerty = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$
        forall a b. [a] -> [b] -> [(a, b)]
zip ([Char]
qwerty_unshifted forall a. [a] -> [a] -> [a]
++ [Char]
qwerty_shifted) ([Char]
unshifted forall a. [a] -> [a] -> [a]
++ [Char]
shifted)
    prefix :: Text
prefix = forall a. Show a => a -> Text
showt [Char]
name forall a. Semigroup a => a -> a -> a
<> Text
": "

qwerty_unshifted, qwerty_shifted :: [Char]
qwerty_unshifted :: [Char]
qwerty_unshifted = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
qwerty_unshifted_rows
qwerty_shifted :: [Char]
qwerty_shifted = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
qwerty_shifted_rows

qwerty_unshifted_rows, qwerty_shifted_rows :: [[Char]]
qwerty_unshifted_rows :: [[Char]]
qwerty_unshifted_rows =
    [ [Char]
"`1234567890-="
    , [Char]
"qwertyuiop[]\\"
    , [Char]
"asdfghjkl;'"
    , [Char]
"zxcvbnm,./"
    ]
qwerty_shifted_rows :: [[Char]]
qwerty_shifted_rows =
    [ [Char]
"~!@#$%^&*()_+"
    , [Char]
"QWERTYUIOP{}|"
    , [Char]
"ASDFGHJKL:\""
    , [Char]
"ZXCVBNM<>?"
    ]

qwerty :: Layout
qwerty :: Layout
qwerty = [Char] -> [Char] -> [Char] -> Layout
layout [Char]
"qwerty" [Char]
qwerty_unshifted [Char]
qwerty_shifted

dvorak :: Layout
dvorak :: Layout
dvorak = [Char] -> [Char] -> [Char] -> Layout
layout [Char]
"dvorak"
    (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"`1234567890[]"
        , [Char]
"',.pyfgcrl/=\\"
        , [Char]
"aoeuidhtns-"
        , [Char]
";qjkxbmwvz"
        ])
    (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"~!@#$%^&*(){}"
        , [Char]
"\"<>PYFGCRL?+|"
        , [Char]
"AOEUIDHTNS_"
        , [Char]
":QJKXBMWVZ"
        ])