module Data.Repa.Nice.Present
( Presentable (..)
, Present (..)
, Str (..)
, Tok (..)
, depth
, strip1
, strip2
, flatten)
where
import Data.Monoid
import Data.Word
import Data.Text (Text)
import Data.Repa.Nice (Str(..), Tok(..))
import Data.Repa.Scalar.Product ((:*:) (..))
import Data.Repa.Scalar.Date32 (Date32)
import qualified Data.Text as T
import qualified Data.Repa.Scalar.Date32 as Date32
import Prelude as P
data Present
= Blank
| Atom Text
| Many [Present]
| Some [Present]
deriving (Eq, Show)
depth :: Present -> Int
depth pp
= case pp of
Blank{} -> 0
Atom{} -> 0
Many ps -> 1 + (case ps of
[] -> 0
_ -> maximum $ map depth ps)
Some _ -> 0
strip2 :: Present -> Maybe [[Present]]
strip2 (Many xs) = mapM strip1 xs
strip2 _ = Nothing
strip1 :: Present -> Maybe [Present]
strip1 (Many xs) = Just xs
strip1 _ = Nothing
flatten :: Present -> Text
flatten Blank = T.pack ""
flatten (Atom str) = str
flatten (Many ps)
= T.pack "[" <> (T.intercalate (T.pack ",") $ map flatten ps) <> T.pack "]"
flatten (Some ps)
= T.pack "(" <> (T.intercalate (T.pack ",") $ map flatten ps) <> T.pack ")"
class Presentable a where
present :: a -> Present
instance Presentable () where
present _ = Blank
instance Presentable Char where
present = Atom . T.pack . show
instance Presentable Int where
present = Atom . T.pack . show
instance Presentable Float where
present = Atom . T.pack . show
instance Presentable Double where
present = Atom . T.pack . show
instance Presentable Word8 where
present = Atom . T.pack . show
instance Presentable Word16 where
present = Atom . T.pack . show
instance Presentable Word32 where
present = Atom . T.pack . show
instance Presentable Word64 where
present = Atom . T.pack . show
instance Presentable Date32 where
present d
| (yy, mm, dd) <- Date32.unpack d
= let cSep = '/'
yy' = show yy
mm' = if mm < 10 then "0" ++ show mm else show mm
dd' = if dd < 10 then "0" ++ show dd else show dd
in Atom $ T.pack $ P.concat [yy', [cSep], mm', [cSep], dd']
instance Presentable Str where
present (Str xs) = Atom $ T.pack (show xs)
instance Presentable Tok where
present (Tok xs) = Atom $ T.pack xs
instance Presentable a
=> Presentable [a] where
present xs = Many $ map present xs
instance (Presentable a, Presentable b)
=> Presentable (a :*: b) where
present (xa :*: xb)
= let aa = case present xa of
Blank -> []
Atom x -> [Atom x]
Many xx -> xx
Some xx -> xx
bb = case present xb of
Blank -> []
Atom x -> [Atom x]
Many xx -> xx
Some xx -> xx
in Some (aa ++ bb)
instance (Presentable a, Presentable b)
=> Presentable (a, b) where
present (a, b)
= Some [present a, present b]
instance (Presentable a, Presentable b, Presentable c)
=> Presentable (a, b, c) where
present (a, b, c)
= Some [present a, present b, present c]
instance (Presentable a, Presentable b, Presentable c, Presentable d)
=> Presentable (a, b, c, d) where
present (a, b, c, d)
= Some [present a, present b, present c, present d]
instance (Presentable a, Presentable b, Presentable c, Presentable d, Presentable e)
=> Presentable (a, b, c, d, e) where
present (a, b, c, d, e)
= Some [present a, present b, present c, present d, present e]