module TM2Tms (tm2tms) where
import Data.List (transpose, intercalate)
import Data.Set (toList)
import Data.Map (fromList, lookup, Map)
import Data.List.NonEmpty (reverse, NonEmpty(..), length)
import Data.Maybe (fromMaybe)
import TMType
import TmsType
tm2tms :: TM -> Either String Tms
tm2tms :: TM -> Either String Tms
tm2tms
(TM
(InputAlphabet
_,
[TapeAlphabet]
tapeAlphabets,
MultiTapeStates
_,
Commands Set [TapeCommand]
commands,
StartStates [State]
startStates,
AccessStates [State]
accessStates)
) = do
[[TmsCommand]]
tmsCmdsBlocks <- ([TapeCommand] -> Either String [TmsCommand])
-> [[TapeCommand]] -> Either String [[TmsCommand]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse [TapeCommand] -> Either String [TmsCommand]
cmd2tmsTapeCmds (Set [TapeCommand] -> [[TapeCommand]]
forall a. Set a -> [a]
toList Set [TapeCommand]
commands)
let tmsCmds :: [TmsCommand]
tmsCmds = [[TmsCommand]] -> [TmsCommand]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TmsCommand]]
tmsCmdsBlocks
[String]
tmsAlph <- (TapeAlphabet -> Either String String)
-> [TapeAlphabet] -> Either String [String]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TapeAlphabet -> Either String String
alph2tmsAlph [TapeAlphabet]
tapeAlphabets
Tms -> Either String Tms
forall (m :: * -> *) a. Monad m => a -> m a
return (Tms -> Either String Tms) -> Tms -> Either String Tms
forall a b. (a -> b) -> a -> b
$ (String, TmsState, [TmsState], [TmsCommand], [String]) -> Tms
Tms (
String
"TMType_TM",
[String] -> TmsState
mergeMultipleNames ([String] -> TmsState) -> [String] -> TmsState
forall a b. (a -> b) -> a -> b
$ (\(State String
s) -> String
s) (State -> String) -> [State] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [State]
startStates,
TmsState -> [TmsState]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TmsState -> [TmsState]) -> TmsState -> [TmsState]
forall a b. (a -> b) -> a -> b
$ [String] -> TmsState
mergeMultipleNames ([String] -> TmsState) -> [String] -> TmsState
forall a b. (a -> b) -> a -> b
$ (\(State String
s) -> String
s) (State -> String) -> [State] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [State]
accessStates,
[TmsCommand]
tmsCmds,
[String]
tmsAlph)
where
alph2tmsAlph :: TapeAlphabet -> Either String String
alph2tmsAlph :: TapeAlphabet -> Either String String
alph2tmsAlph (TapeAlphabet Set Square
squares) = (Square -> Either String Char) -> [Square] -> Either String String
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Square -> Either String Char
toValue (Set Square -> [Square]
forall a. Set a -> [a]
toList Set Square
squares)
tmState2tmsState :: State -> TmsState
tmState2tmsState :: State -> TmsState
tmState2tmsState (State String
s) = String -> TmsState
TmsState String
s
makeTransSt :: State -> State -> State
makeTransSt :: State -> State -> State
makeTransSt (State String
from) (State String
to) = String -> State
State (String -> State) -> String -> State
forall a b. (a -> b) -> a -> b
$ String
"FROM_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
from String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_TO_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
to
cmd2tmsTapeCmd :: TapeCommand -> Either String (NonEmpty OneTapeTMCommand)
cmd2tmsTapeCmd :: TapeCommand -> Either String (NonEmpty OneTapeTMCommand)
cmd2tmsTapeCmd (
SingleTapeCommand (
(Square
ES, State
iniSt, Square
RBS),
(Square
ES, State
folSt, Square
RBS))
) = NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand)
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand))
-> NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand)
forall a b. (a -> b) -> a -> b
$
(State -> TmsState
tmState2tmsState State
iniSt, (TmsTapeSquare, TmsTapeHeadMovement) -> TmsSingleTapeCommand
TmsSingleTapeCommand (TmsTapeSquare
Leave, TmsTapeHeadMovement
Stay), State -> TmsState
tmState2tmsState State
folSt) OneTapeTMCommand -> [OneTapeTMCommand] -> NonEmpty OneTapeTMCommand
forall a. a -> [a] -> NonEmpty a
:|
[]
cmd2tmsTapeCmd (
SingleTapeCommand (
(Square
ES, State
iniSt, Square
RBS),
(Value String
name Int
nquts, State
folSt, Square
RBS)
)) = do
Char
ch <- String -> Int -> Either String Char
quotName2Char String
name Int
nquts
let transit :: TmsState
transit = State -> TmsState
tmState2tmsState (State -> TmsState) -> State -> TmsState
forall a b. (a -> b) -> a -> b
$ State -> State -> State
makeTransSt State
iniSt State
folSt
NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand)
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand))
-> NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand)
forall a b. (a -> b) -> a -> b
$
(State -> TmsState
tmState2tmsState State
iniSt, (TmsTapeSquare, TmsTapeHeadMovement) -> TmsSingleTapeCommand
TmsSingleTapeCommand (TmsTapeSquare
Leave, TmsTapeHeadMovement
MoveLeft), TmsState
transit) OneTapeTMCommand -> [OneTapeTMCommand] -> NonEmpty OneTapeTMCommand
forall a. a -> [a] -> NonEmpty a
:|
[(TmsState
transit, (TmsTapeSquare, TmsTapeHeadMovement) -> TmsSingleTapeCommand
TmsSingleTapeCommand (Char -> Char -> TmsTapeSquare
ChangeFromTo Char
'_' Char
ch, TmsTapeHeadMovement
Stay), State -> TmsState
tmState2tmsState State
folSt)]
cmd2tmsTapeCmd (
SingleTapeCommand (
(Value String
name Int
nquts, State
iniSt, Square
RBS),
(Square
ES, State
folSt, Square
RBS)
)) = do
Char
ch <- String -> Int -> Either String Char
quotName2Char String
name Int
nquts
NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand)
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand))
-> NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand)
forall a b. (a -> b) -> a -> b
$
(State -> TmsState
tmState2tmsState State
iniSt, (TmsTapeSquare, TmsTapeHeadMovement) -> TmsSingleTapeCommand
TmsSingleTapeCommand (Char -> Char -> TmsTapeSquare
ChangeFromTo Char
ch Char
'_', TmsTapeHeadMovement
MoveRight), State -> TmsState
tmState2tmsState State
folSt) OneTapeTMCommand -> [OneTapeTMCommand] -> NonEmpty OneTapeTMCommand
forall a. a -> [a] -> NonEmpty a
:|
[]
cmd2tmsTapeCmd (
SingleTapeCommand (
(Value String
iniName Int
iniNquts, State
iniSt, Square
RBS),
(Value String
folName Int
folNquts, State
folSt, Square
RBS)
)) = do
Char
iniCh <- String -> Int -> Either String Char
quotName2Char String
iniName Int
iniNquts
Char
folCh <- String -> Int -> Either String Char
quotName2Char String
folName Int
folNquts
NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand)
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand))
-> NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand)
forall a b. (a -> b) -> a -> b
$
(State -> TmsState
tmState2tmsState State
iniSt, (TmsTapeSquare, TmsTapeHeadMovement) -> TmsSingleTapeCommand
TmsSingleTapeCommand (Char -> Char -> TmsTapeSquare
ChangeFromTo Char
iniCh Char
folCh, TmsTapeHeadMovement
Stay), State -> TmsState
tmState2tmsState State
folSt) OneTapeTMCommand -> [OneTapeTMCommand] -> NonEmpty OneTapeTMCommand
forall a. a -> [a] -> NonEmpty a
:|
[]
cmd2tmsTapeCmd (
SingleTapeCommand (
(Square
LBS, State
iniSt, Square
RBS),
(Square
LBS, State
folSt, Square
RBS)
)) = NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand)
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand))
-> NonEmpty OneTapeTMCommand
-> Either String (NonEmpty OneTapeTMCommand)
forall a b. (a -> b) -> a -> b
$
(State -> TmsState
tmState2tmsState State
iniSt, (TmsTapeSquare, TmsTapeHeadMovement) -> TmsSingleTapeCommand
TmsSingleTapeCommand (Char -> Char -> TmsTapeSquare
ChangeFromTo Char
'_' Char
'_', TmsTapeHeadMovement
Stay), State -> TmsState
tmState2tmsState State
folSt) OneTapeTMCommand -> [OneTapeTMCommand] -> NonEmpty OneTapeTMCommand
forall a. a -> [a] -> NonEmpty a
:|
[]
cmd2tmsTapeCmd TapeCommand
cmd = String -> Either String (NonEmpty OneTapeTMCommand)
forall a b. a -> Either a b
Left (String -> Either String (NonEmpty OneTapeTMCommand))
-> String -> Either String (NonEmpty OneTapeTMCommand)
forall a b. (a -> b) -> a -> b
$ String
"Command '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ TapeCommand -> String
forall a. Show a => a -> String
show TapeCommand
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' can not be converted to '[TmsSingleTapeCommand]'"
cmd2tmsTapeCmds :: [TapeCommand] -> Either String [TmsCommand]
cmd2tmsTapeCmds :: [TapeCommand] -> Either String [TmsCommand]
cmd2tmsTapeCmds [TapeCommand]
tapeCmds = do
[NonEmpty OneTapeTMCommand]
tapeCmdSeqs <- (TapeCommand -> Either String (NonEmpty OneTapeTMCommand))
-> [TapeCommand] -> Either String [NonEmpty OneTapeTMCommand]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TapeCommand -> Either String (NonEmpty OneTapeTMCommand)
cmd2tmsTapeCmd [TapeCommand]
tapeCmds
let tapeCmdSeqsRev :: [NonEmpty OneTapeTMCommand]
tapeCmdSeqsRev = (NonEmpty OneTapeTMCommand -> NonEmpty OneTapeTMCommand)
-> [NonEmpty OneTapeTMCommand] -> [NonEmpty OneTapeTMCommand]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map NonEmpty OneTapeTMCommand -> NonEmpty OneTapeTMCommand
forall a. NonEmpty a -> NonEmpty a
Data.List.NonEmpty.reverse [NonEmpty OneTapeTMCommand]
tapeCmdSeqs
let mxLen :: Int
mxLen = (Int -> NonEmpty OneTapeTMCommand -> Int)
-> Int -> [NonEmpty OneTapeTMCommand] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
mx NonEmpty OneTapeTMCommand
sq -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
mx (NonEmpty OneTapeTMCommand -> Int
forall a. NonEmpty a -> Int
Data.List.NonEmpty.length NonEmpty OneTapeTMCommand
sq)) Int
0 [NonEmpty OneTapeTMCommand]
tapeCmdSeqs
let sameLenCmds :: [[OneTapeTMCommand]]
sameLenCmds = (NonEmpty OneTapeTMCommand -> [OneTapeTMCommand])
-> [NonEmpty OneTapeTMCommand] -> [[OneTapeTMCommand]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> NonEmpty OneTapeTMCommand -> [OneTapeTMCommand]
fillSeqWithIdCmds Int
mxLen) [NonEmpty OneTapeTMCommand]
tapeCmdSeqsRev
let sameLenCmdsRev :: [[OneTapeTMCommand]]
sameLenCmdsRev = [[OneTapeTMCommand]] -> [[OneTapeTMCommand]]
forall a. [[a]] -> [[a]]
transpose ([[OneTapeTMCommand]] -> [[OneTapeTMCommand]])
-> [[OneTapeTMCommand]] -> [[OneTapeTMCommand]]
forall a b. (a -> b) -> a -> b
$ ([OneTapeTMCommand] -> [OneTapeTMCommand])
-> [[OneTapeTMCommand]] -> [[OneTapeTMCommand]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [OneTapeTMCommand] -> [OneTapeTMCommand]
forall a. [a] -> [a]
Prelude.reverse [[OneTapeTMCommand]]
sameLenCmds
[TmsCommand] -> Either String [TmsCommand]
forall (m :: * -> *) a. Monad m => a -> m a
return ([TmsCommand] -> Either String [TmsCommand])
-> [TmsCommand] -> Either String [TmsCommand]
forall a b. (a -> b) -> a -> b
$ (\[OneTapeTMCommand]
cmds -> (TmsState, [TmsSingleTapeCommand], TmsState) -> TmsCommand
TmsCommand ([OneTapeTMCommand] -> TmsState
forall b c. [(TmsState, b, c)] -> TmsState
startState [OneTapeTMCommand]
cmds, [OneTapeTMCommand] -> [TmsSingleTapeCommand]
forall a b c. [(a, b, c)] -> [b]
commands [OneTapeTMCommand]
cmds, [OneTapeTMCommand] -> TmsState
forall a b. [(a, b, TmsState)] -> TmsState
finalState [OneTapeTMCommand]
cmds)) ([OneTapeTMCommand] -> TmsCommand)
-> [[OneTapeTMCommand]] -> [TmsCommand]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[OneTapeTMCommand]]
sameLenCmdsRev
where
fillSeqWithIdCmds :: Int -> NonEmpty OneTapeTMCommand -> [OneTapeTMCommand]
fillSeqWithIdCmds :: Int -> NonEmpty OneTapeTMCommand -> [OneTapeTMCommand]
fillSeqWithIdCmds Int
len (OneTapeTMCommand
x :| [OneTapeTMCommand]
xs) = Int -> OneTapeTMCommand -> [OneTapeTMCommand]
forall a. Int -> a -> [a]
replicate (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- [OneTapeTMCommand] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [OneTapeTMCommand]
xs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (OneTapeTMCommand -> OneTapeTMCommand
makeIdTapeCommand OneTapeTMCommand
x) [OneTapeTMCommand] -> [OneTapeTMCommand] -> [OneTapeTMCommand]
forall a. [a] -> [a] -> [a]
++ OneTapeTMCommand -> [OneTapeTMCommand]
forall (f :: * -> *) a. Applicative f => a -> f a
pure OneTapeTMCommand
x [OneTapeTMCommand] -> [OneTapeTMCommand] -> [OneTapeTMCommand]
forall a. [a] -> [a] -> [a]
++ [OneTapeTMCommand]
xs
makeIdTapeCommand :: OneTapeTMCommand -> OneTapeTMCommand
makeIdTapeCommand :: OneTapeTMCommand -> OneTapeTMCommand
makeIdTapeCommand (TmsState
_, TmsSingleTapeCommand
_, TmsState
st) = (TmsState
st, (TmsTapeSquare, TmsTapeHeadMovement) -> TmsSingleTapeCommand
TmsSingleTapeCommand (TmsTapeSquare
Leave, TmsTapeHeadMovement
Stay), TmsState
st)
startState :: [(TmsState, b, c)] -> TmsState
startState = [String] -> TmsState
mergeMultipleNames ([String] -> TmsState)
-> ([(TmsState, b, c)] -> [String])
-> [(TmsState, b, c)]
-> TmsState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TmsState, b, c) -> String) -> [(TmsState, b, c)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TmsState String
s, b
_, c
_) -> String
s)
finalState :: [(a, b, TmsState)] -> TmsState
finalState = [String] -> TmsState
mergeMultipleNames ([String] -> TmsState)
-> ([(a, b, TmsState)] -> [String])
-> [(a, b, TmsState)]
-> TmsState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b, TmsState) -> String) -> [(a, b, TmsState)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(a
_, b
_, TmsState String
f) -> String
f)
commands :: [(a, b, c)] -> [b]
commands = ((a, b, c) -> b) -> [(a, b, c)] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a, b, c) -> b) -> [(a, b, c)] -> [b])
-> ((a, b, c) -> b) -> [(a, b, c)] -> [b]
forall a b. (a -> b) -> a -> b
$ \(a
_, b
x, c
_) -> b
x
toValue :: Square -> Either String Char
toValue :: Square -> Either String Char
toValue (Value String
name Int
n) =
String -> Int -> Either String Char
quotName2Char String
name Int
n
toValue Square
_ = String -> Either String Char
forall a b. a -> Either a b
Left String
"Square is expected to be 'Value' to convert to 'Char'"
quotName2Char :: String -> Int -> Either String Char
quotName2Char :: String -> Int -> Either String Char
quotName2Char (Char
c : String
"") Int
0 = Char -> Either String Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c
quotName2Char (Char
c : String
"") Int
1 = Char -> Either String Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Either String Char) -> Char -> Either String Char
forall a b. (a -> b) -> a -> b
$ Char -> Char
toQuot Char
c
quotName2Char String
name Int
nQuot = String -> Either String Char
forall a b. a -> Either a b
Left (String -> Either String Char) -> String -> Either String Char
forall a b. (a -> b) -> a -> b
$ String
"Can not convert string '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' with " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
nQuot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" quotes into 'Char'."
quoted :: Data.Map.Map Char Char
quoted :: Map Char Char
quoted = [(Char, Char)] -> Map Char Char
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Char
'a', Char
'à'), (Char
'b', Char
'ƀ'), (Char
'c', Char
'ć'), (Char
'd', Char
'ď'), (Char
'e', Char
'ė'), (Char
'f', Char
'ƒ'), (Char
'g', Char
'ĝ'), (Char
'h', Char
'ĥ'), (Char
'i', Char
'ĩ'), (Char
'j', Char
'ĵ'), (Char
'k', Char
'ķ'), (Char
'l', Char
'ĺ'), (Char
'm', Char
'ɱ'), (Char
'n', Char
'ń'), (Char
'o', Char
'ō'), (Char
'p', Char
'ƥ'), (Char
'q', Char
'ɋ'), (Char
'r', Char
'ŕ'), (Char
's', Char
'ś'), (Char
't', Char
'ť'), (Char
'u', Char
'ū'), (Char
'v', Char
'ʌ'), (Char
'w', Char
'ŵ'), (Char
'x', Char
'×'), (Char
'y', Char
'ŷ'), (Char
'z', Char
'ź'), (Char
'A', Char
'Ã'), (Char
'B', Char
'Ɓ'), (Char
'C', Char
'Ć'), (Char
'D', Char
'Đ'), (Char
'E', Char
'Ė'), (Char
'F', Char
'Ƒ'), (Char
'G', Char
'Ĝ'), (Char
'H', Char
'Ĥ'), (Char
'I', Char
'Ĩ'), (Char
'J', Char
'Ĵ'), (Char
'K', Char
'Ķ'), (Char
'L', Char
'Ĺ'), (Char
'M', Char
'Ɯ'), (Char
'N', Char
'Ń'), (Char
'O', Char
'Ō'), (Char
'P', Char
'Ƥ'), (Char
'Q', Char
'Ɋ'), (Char
'R', Char
'Ŕ'), (Char
'S', Char
'Ś'), (Char
'T', Char
'Ť'), (Char
'U', Char
'Ū'), (Char
'V', Char
'Ʌ'), (Char
'W', Char
'Ŵ'), (Char
'X', Char
'χ'), (Char
'Y', Char
'Ŷ'), (Char
'Z', Char
'Ź')]
toQuot :: Char -> Char
toQuot :: Char -> Char
toQuot Char
c = Char -> Maybe Char -> Char
forall a. a -> Maybe a -> a
fromMaybe (String -> Char
forall a. HasCallStack => String -> a
error (String -> Char) -> String -> Char
forall a b. (a -> b) -> a -> b
$ String
"Can not find character with quote for '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'") (Char -> Map Char Char -> Maybe Char
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup Char
c Map Char Char
quoted)
mergeMultipleNames :: [String] -> TmsState
mergeMultipleNames :: [String] -> TmsState
mergeMultipleNames = String -> TmsState
TmsState (String -> TmsState)
-> ([String] -> String) -> [String] -> TmsState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Q__" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ) (String -> String) -> ([String] -> String) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"__" ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
filterStateName ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
enum
where
enum :: [String] -> [String]
enum [String]
ss = ((Integer, String) -> String) -> [(Integer, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Integer
num, String
s) -> Integer -> String
forall a. Show a => a -> String
show Integer
num String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"__" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s) ([Integer] -> [String] -> [(Integer, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [String]
ss)