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