Writer.hs

module  Control.Carbonara.Writer where

import           Data.Carbonara.String (replaceStrOnce)
import           Data.List (intercalate)
import           Data.List.Split (chunksOf) --split








-- | > incrementWord "(Show x)" 6 -> "(Show x1, Show x2, Show x3, Show x4, Show x5, Show x6)"
incrementWord :: String -> Int -> String
incrementWord str n = open_mark ++ (intercalate ", " $ zipWith (++) word_list num_list) ++ close_mark
                      where word_list = replicate n . drop 1 . reverse . drop 1 . reverse $ str
                            num_list = map show [1..n]
                            open_mark = take 1 str
                            close_mark = take 1 . reverse $ str


-- | > repeatWord "(Nothing)" 5 -> "(Nothing, Nothing, Nothing, Nothing, Nothing)"
repeatWord :: String -> Int -> String
repeatWord str n = open_mark ++ (intercalate ", " word_list) ++ close_mark
                   where word_list = replicate n . drop 1 . reverse . drop 1 . reverse $ str
                         open_mark = take 1 str
                         close_mark = take 1 . reverse $ str
                            


-- show_tuple function is in  GHC.Show module but it does not export this function
show_tuple :: [ShowS] -> ShowS 
show_tuple ss = showChar '('
              . foldr1 (\s r -> s . showChar ',' . r) ss
              . showChar ')'


----------------------------------------------------------------------------------------------

-- compare Prelude Library Show instance
composeShowTuple :: Int -> String
composeShowTuple i = concat [ "\n-- | Show Tuple", i' 
                            , "\ninstance ", incrementWord "(Show x)" i
                            , "\n        => Show ", incrementWord "(x)" i, " where"
                            , "\n  showsPrec _ ", incrementWord "(x)" i, " s"
                            , "\n        = show_tuple ", incrementWord "[shows x]" i, " s"
                            , "\n\n" ]
                            where i' = show i


appendShowTuple :: FilePath -> IO ()
appendShowTuple path = mapM_ (\i-> appendFile path (composeShowTuple i)) [16..62]
-- ^  official pkg only have 1 to 15
-- max size is 62-tuple



composeToRow :: Int -> String
composeToRow i = concat [ "\n-- | ToRow", i'
                        , "\ninstance ", incrementWord "(ToField x)" i
                        , "\n        => ToRow ", incrementWord "(x)" i, " where"
                        , "\n  toRow ", incrementWord "(x)" i
                        , "\n        = ", incrementWord "[toField x]" i
                        , "\n\n" ]
                        where i' = show i

appendToRow :: FilePath -> IO ()
appendToRow path = mapM_ (\i -> appendFile path (composeToRow i)) [11..62]  -- official pkg only have 1 to 10




composeListToTuple :: Int -> String
composeListToTuple i = concat [ "\n", "listToTuple", i', " :: [a] -> ", repeatWord "(Maybe a)" i
                              , "\n", "listToTuple", i', " ", incrementWord "[x]" i, " ="
                              , "\n", "    ", incrementWord "(Just x)" i
                              , "\n", "listToTuple", i', " _ = ", repeatWord "(Nothing)" i
                              , "\n\n" ]
                              where i' = show i

appendListToTuple :: FilePath -> IO ()
appendListToTuple path = mapM_ (\i -> appendFile path (composeListToTuple i)) [2..62]  -- 2 to 62 


composeTupleToList :: Int -> String
composeTupleToList i = concat [ "\n", "tupleToList", i', " :: ", incrementWord "(Show x)" i
                              , "\n                 => ", incrementWord "(x)" i, " -> [Maybe String]"
                              , "\n", "tupleToList", i', " ", incrementWord "(x)" i, " ="
                              , "\n", "    ", incrementWord "[readS x]" i
                              , "\n\n" ]
                              where i' = show i


appendTupleToList :: FilePath -> IO ()
appendTupleToList path = mapM_ (\i -> appendFile path (composeTupleToList i)) [2..62]  -- 2 to 62 



composeField :: Int -> Int -> String
composeField fieldnum i = concat
                      [ "\n-- | Field", fieldstr, "_", i'
                      , "\ninstance Field", fieldstr, " ", incrementWord "(x)" i, " "
                      , replacex $ incrementWord "(x)" i, " ", xn, " ", xn', " where"
                      , "\n    _", fieldstr, " k ~", incrementWord "(x)" i, " ="
                      , "\n        ", "k ", xn, " <&> \\", xn', " -> "
                      , replacex $ incrementWord "(x)" i
                      , "\n\n" ]
                      where i' = show i
                            fieldstr = show fieldnum
                            xn = "x" ++ fieldstr
                            xn'= xn ++ "\'"
                            replacex s = replaceStrOnce xn xn' s


appendField :: FilePath -> Int -> IO ()
appendField path n = mapM_ (\i -> appendFile path (composeField n i)) [10..62]  --official pkg has 1 to 9