summaryrefslogtreecommitdiff
path: root/src/Data/CSV/Table/Types.hs
blob: c81b170eda3b6b92f038707df130898ce6bd5a2f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117

module Data.CSV.Table.Types (

  -- * Representation
    Table (..)
  , Row (..)
  , Col (..)
  , RowInfo
  , TField (..)
  , Order (..)

  -- * Accessors
  , getCols
  , getRows
  , lookupCol

  -- * Parsing
  , fromFile
  , fromString

  -- * Saving
  , toFile

  ) where

import           Text.Printf
import           Text.CSV
import           System.FilePath
import           Control.Applicative ((<$>))
import           Data.Maybe
import           Data.List (sort, elemIndex)
import qualified Data.Map.Strict as M

newtype Col  = C Field   deriving (Eq, Ord, Show)
newtype Row  = R [Field] deriving (Eq, Ord, Show)
type RowInfo = [(Col, Field)]

-----------------------------------------------------------------------------------
-- | Types
-----------------------------------------------------------------------------------

data Table  = T { dim :: Int, cols :: [Col], body :: [Row]}

{-@ measure width :: Row -> Int
    width (R xs) = (len xs)                                                     @-}

{-@ type ColsN N = {v:[Col] | (len v)   = N}                                    @-}
{-@ type RowN  N = {r:Row   | (width r) = N}                                    @-}
{-@ data Table   = T (dim :: Nat) (cols :: (ColsN dim)) (body :: [(RowN dim)])  @-}

{-@ getCols   :: t:Table -> ListN Field {(dim t)} @-}
getCols t = [c | C c <- cols t]

{-@ getRows   :: t:Table -> ListN Field {(dim t)} @-}
getRows t = [r | R r <- body t]

lookupCol :: Col -> RowInfo -> Field
lookupCol c cxs = fromMaybe err $ lookup c cxs
  where
    err         = printf "lookupCol: cannot find %s in %s" (show c) (show cxs)

--------------------------------------------------------------------------------
-- | Field Sorts
--------------------------------------------------------------------------------

data TField = FStr | FInt | FDbl
            deriving (Eq, Ord, Show)

data Order  = Asc | Dsc
            deriving (Eq, Ord, Show)
----------------------------------------------------------------------
-- | Converting to CSV
----------------------------------------------------------------------

fromCSV        :: CSV -> Table
fromCSV []     = error "fromCSV: Empty CSV with no rows!"
fromCSV (r:rs) = T n cs b
  where
    n          = length r
    cs         = [C x | x <- r]
    b          = mapMaybe (makeRow n) $ zip [0..] rs

makeRow :: Int -> (Int, Record) -> Maybe Row
makeRow n (i, xs)
  | length xs == n = Just $ R xs
  | empty xs       = Nothing
  | otherwise      = error $ printf "Row %d does not have %d columns:\n%s" i n (show xs)

empty :: Record -> Bool
empty = null . unwords

toCSV   :: Table -> CSV
toCSV t = [c | C c <- cols t] : [xs | R xs <- body t]

--------------------------------------------------------------------------------
-- | Parsing
--------------------------------------------------------------------------------

toFile   :: FilePath -> Table -> IO ()
toFile f = writeFile f . show

fromFile    :: FilePath -> IO Table
fromFile  f = fromString f <$> readFile f

fromString      :: FilePath -> String -> Table
fromString fp s = fromCSV $ parseCSV' fp s

parseCSV' fp s = case parseCSV fp s of
                   Right c -> c
                   Left e  -> error $ printf "parseCSV': %s" (show e)

--------------------------------------------------------------------------------
-- | Printing
--------------------------------------------------------------------------------

instance Show Table where
  show = printCSV . toCSV